Excel VBA 平成の必要な分だけ令和に絞り込んで変換するマクロ

#まずこんな変換をやってはいけない
そこだけ文字列になるため、「うちのシステムは令和に対応していません」といえばいいものを無理に使うためよけい面倒なことになる

#自分のところは変わっていないしユーザーの責任でもない、この業界は人を馬鹿にしすぎ
しょせんマイクロソフトの威光を借りているだけのネズミごときが書いたブログなどあり腰を抜かさんばかりに驚くなど

 2019-04-01
【令和れいわ】Excelを業務で使用している場合の新元号対応と注意点まとめ 
https://www.waenavi.com/entry/20190401/1554087637#%EF%BC%90%E4%BB%A4%E5%92%8C%E3%81%8C%E8%A1%A8%E7%A4%BA%E3%81%95%E3%82%8C%E3%81%AA%E3%81%84%E3%81%AE%E3%81%AF%E3%83%A6%E3%83%BC%E3%82%B6%E3%81%AE%E8%B2%AC%E4%BB%BB%E3%81%A7%E3%81%99
０．令和が表示されないのはユーザの責任です！

>日本時間の2019年5月2日（木）の時点で、サポートされているすべてのバージョンのWindowsとOfficeで令和対応の更新プログラムが配布されました。また、更新時のトラブル等を除き、Excelで正しく「令和」が表示されることも確認されました。
>これによりマイクロソフトの令和対応はほぼ完了したものと思われます。マイクロソフトの皆さん、本当にお疲れさまでした。
>　したがって、5月3日（金）以降、Excelで「令和」が表示されないのであれば、それはマイクロソフトの責任ではありません。パソコンのユーザ側に100％の責任があります。和暦を使わないのであればそのまま放置しても全く問題はありませんが、業務で和暦を使うのであればユーザの責任で各自対応する必要があります。
しかしながら、パソコンの知識が十分でない場合、対応するのが困難と思われます。そこで、初心者の皆さんや学生の皆さんが学習するための記事をご用意いたしました。こちらの記事をご覧ください。

あのな、「しかしながら」がつくような対応はお疲れ様じゃない。なにやっとんのやゴミクロソフトが。高い金出していまだに平成なら更新する意味が全くないではないか。あとパソコンの知識が十分でも対応するのは無理。まさに強気を助け弱気をくじくとしか感じられない。


#でいまのところの結論は
変換するセルを絞り込む
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/126919/bf7520e3-11d3-c5f2-9b61-eab9f9fe8b90.png)

B3の平成34年12月1日
しかしこれは表示形式で平成表示されており、
実際は2022/12/1という値である。
このようなセルを
令和04年12月01日
のように変える。
https://qiita.com/Q11Q/items/c589e673f36d592043fd
B1とB2は上記で扱った式で、ユーザー定義関数が入っているため、変換する必要性がない。

04にしないと令和元年と並ばない。
###日付はJST(Asia/Tokyo UTC+09:00)のみ
前の記事で述べたように混在させたら何らかの形で識別して場合分けをしなければならない。
このVBAはその発展性を考えて、システムのタイムゾーンオフセットを取得している。
これはWin32Api(64/32Bit)で取得している。
また、裏で元号の日付変換可能な文字列を見つけ出している。
また少なくとも平成元年と令和元年は識別する。
数式、エラーがある個所はSkipする。

###問題点
全角の表示形式[DBNum3]に対応していない、すべて半角になる。

#参照設定
Microsoft VBScript Regular Expression 5.5
Microsoft WMI Scripting V1.2
下は使わないのだが、もしWin32 APIが使えない場合があれば、WMIで取得するので、一応これは設定する。

```vb
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TimeZoneInfo) As Long
#Else
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TimeZoneInfo) As Long
#End If
Private Type SystemTime
    intYear As Integer
    intMonth As Integer
    intwDayOfWeek As Integer
    intDay As Integer
    intHour As Integer
    intMinute As Integer
    intSecond As Integer
    intMilliseconds As Integer
End Type
Private Type TimeZoneInfo
    lngBias As Long
    intStandardName(32) As Integer
    intStandardDate As SystemTime
    intStandardBias As Long
    intDaylightName(32) As Integer
    intDaylightDate As SystemTime
    intDaylightBias As Long
End Type
Public Function GetUTCOffset() As Date
Dim lngRet As Long
Dim udtTZI As TimeZoneInfo

lngRet = GetTimeZoneInformation(udtTZI)
GetUTCOffset = udtTZI.lngBias / 60 / 24
End Function

Sub 平成令和Asia_TokyoOnly()
'昭和以降しかない
'平成だけ変換する
'入力してある日付はすべて日本標準時 JST UTC +9:00 Asia/Tokyo
Dim R As Range
Dim DT As Date
Dim buf As String
Const TimeZoneString0900 = "Asia/Tokyo"
Const TimeZoneString0900Local = "JST" 'JSTは一般的な呼称としては不適切、現在はAsia/Tokyoとすべき
Const TimeZoneSystemTime As Date = "09:00:00"
Const REIWAStartDTUTC As String = "2019/4/30 16:00:00" '文字列としないとシステムで日付を読み込むと勝手にUTC以外で解釈される
Dim wb As Workbook, ws As Worksheet: Set wb = ThisWorkbook
Dim strJpnEraName As String '元号 Era Name
Dim REX As New RegExp, MC As MatchCollection, SMs As SubMatches, iYear As Long, iMonth As Byte, iDay As Byte 'Byteを使用することで過大を防ぐ
Dim tRex As New RegExp, tMC As MatchCollection, i2, tHour As Integer, tMin As Integer, tSec As Integer

'Dim TimeZoneParameter As Long
'Dim TizSet As SWbemObjectSet
'Dim Tiz As SWbemObject
'Dim Locator As New WbemScripting.SWbemLocator
'Dim Service As SWbemServices
'Dim MesStr As String
'Set Service = Locator.ConnectServer
'Set TizSet = Service.ExecQuery("Select * From Win32_TimeZone")
'For Each Tiz In TizSet
'TimeZoneParameter = Tiz.Bias / 60
'Debug.Print MesStr
'Next

For Each ws In wb.Worksheets
For Each R In ws.UsedRange
If isFormula2010(R) = False Then
Debug.Print R.Address

With REX
.Global = True
.IgnoreCase = False
.MultiLine = True
.Pattern = "(明治|大正|平成|令和)([0-9]{1,2}|[０-９]{1,2}|元)年([0-9]{1,2}|[０-９]{1,2})月([0-9]{1,2}||[０-９]{1,2})日"
If .Test(R.Value) Then
  Set MC = .Execute(R.Value)
  Set SMs = MC.Item(0).SubMatches
  strJpnEraName = SMs(0)
    If SMs(1) <> "元" Then iYear = StrConv(SMs(1), vbNarrow) Else iYear = 1
    iMonth = StrConv(SMs(2), vbNarrow)
    iDay = StrConv(SMs(3), vbNarrow)
  Select Case strJpnEraName
  Case Is = "昭和"
    iYear = iYear + 1925
    DT = CDate(iYear & "/" & iMonth & "/" & iDay)
  Case Is = "平成"
    iYear = iYear + 1988
    DT = iYear & "/" & iMonth & "/" & iDay
  Case Is = "令和"
    iYear = iYear + 2018
    DT = CDate(iYear & "/" & iMonth & "/" & iDay)
  End Select
  If DT >= CDate("2019/05/01 00:00:00") Then
    buf = ""
    If Year(DT) = 2019 Then buf = "令和元年" & Format(Month(DT), "00") & "月" & Format(Day(DT), "00") & "日" Else buf = "令和" & Format(Year(DT) - 2018, "00") & "年" & Format(Month(DT), "00") & "月" & Format(Day(DT), "00") & "日"
    R.ClearContents
    R.Value = buf
   End If
End If

End With
buf = ""
DT = 0

ElseIf IsDate(R.Value) = True Then
  If CDate(R.Value) >= CDate("2019/05/01 00:00:00") Then
  If R.NumberFormatLocal Like "*ggge*""年""*" Then 'ここは表示形式が微妙に変わる
  Debug.Print R.Value & " " & R.Address
  DT = CDate(R.Value)
  If Year(DT) = 2019 Then buf = "令和元年" & Format(Month(DT), "00") & "月" & Format(Day(DT), "00") & "日" Else buf = "令和" & Format(Year(DT) - 2018, "00") & "年" & Format(Month(DT), "00") & "月" & Format(Day(DT), "00") & "日"
  R.ClearContents
  R.Value = buf
  buf = ""
  DT = 0
  End If
  End If
End If
Next 'R
Next 'ws
End Sub
Function isFormula2010(Rng As Range) As Boolean
’従来と異なるのはエラーも数式として扱わないという点
If IsError(Rng) = False Then
If Rng.Value = CStr(Rng.Formula) Then isFormula2010 = False Else isFormula2010 = True
Else
isFormula2010 = False
End If
End Function
```

#適用後
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/126919/eeb46b65-39d4-8462-523a-27cd49c8a966.png)
マクロを起動させると数式以外の日付でかつ、西暦で入っているデータが表示形式で元号になっているものに対応している。