エクセルVBA「日付形式の日付を、文字列形式に変換する」

エクセルVBAの便利マクロ「選択した ‘yy/mm/dd’書式の日付を’yymmdd’ or ‘yyyymmdd’形式の文字列へ変換するマクロ」をシェアします。

参考になれば幸いです。

機能紹介
マクロコード紹介
まとめ

機能紹介

マクロを実行すると、選択した ‘yy/mm/dd’書式の日付を’yymmdd’ or ‘yyyymmdd’形式の文字列へ変換します。

エクセルVBAの便利マクロ「選択した 'yy/mm/dd'書式の日付を'yymmdd' or 'yyyymmdd'形式の文字列へ変換するマクロ」 — 文字列形式に変換したい対象セルを選択します

マクロコード紹介

コードは以下の通りです。

Option Explicit

'*** Private定数宣言


'*** Private変数宣言
Private oBook           As Object
Private oSht            As Object

Private nSRow           As Long
Private nERow           As Long
Private nCRow           As Long

Private nSCol           As Integer
Private nECol           As Integer
Private nCCol           As Integer

Private bCng            As Boolean
Private nColWid         As Integer

Private nErr         As Integer
Private rTmp         As Range
Private sTmp         As String
Private sMsg         As String



'
'### 文字形式への変換プロシージャ
'### 'yyyy/m/d' or 'yy/mm/dd'書式の日付を'yyyymmdd'形式の文字列へ変換する

Sub 日付_文字変換()

On Error GoTo ErrChk
   
      '*** 初期設定
      nErr = 0
   
      '*** 選択範囲の上端,左端,右端を取得
      nSRow = Selection.Row
      nSCol = Selection.Column
      nECol = nSCol + Selection.Columns.Count - 1
   
      '*** 選択列分ループ
      For nCCol = nSCol To nECol
       
            '*** 最終行の再設定
            nERow = nSRow + Selection.Rows.Count - 1
            If nERow = Rows.Count And Cells(nERow, nCCol).Value = "" Then
                  nERow = Cells(Rows.Count, nCCol).End(xlUp).Row
            End If
       
            '*** 座標と値を取得
            Set rTmp = Range(Cells(nSRow, nCCol), Cells(nERow, nCCol))
       
            '*** 形式変換ループ
            For nCRow = nSRow To nERow
           
                  '*** 形式変換処理（日付→文字列）
                  sTmp = CStr(Cells(nCRow, nCCol).Value)
                  If sTmp <> "" Then
                        sTmp = Format(sTmp, "yyyymmdd")
                        Cells(nCRow, nCCol).Value = sTmp
                  End If
           
            Next nCRow
       
            '*** セルの書式設定
            rTmp.NumberFormatLocal = "@"
       
      Next nCCol
   
      '*** 終了処理
      Set rTmp = Nothing
      Exit Sub
   
ErrChk:
      '*** ユーザーエラーコード
      Select Case nErr
      Case 0                           'エラーなし
            sMsg = sMsg
      Case Else
            sMsg = "予期せぬエラー nErr = " & nErr
      End Select
   
      '*** ＶＢＡエラーコード
      Select Case Err
      Case 0                           'エラーなし
            sMsg = sMsg
      Case 6
            If nCRow = 0 Then nCRow = nERow
            Set rTmp = Cells(nCRow, nCCol)
            sMsg = ""
            sMsg = sMsg & "日付が正しくありません Err = " & Err & Chr(13)
            sMsg = sMsg & "Range(" & rTmp.Address & ")"
            Set rTmp = Range(Cells(nSRow, nCCol), Cells(nCRow - 1, nCCol))
            rTmp.NumberFormatLocal = "@"
       
      Case Else
            sMsg = "予期せぬエラー Err = " & Err
      End Select
   
      MsgBox sMsg, vbOKOnly + vbCritical
      Set rTmp = Nothing
      End
   
End Sub