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

Excelマクロ(VBA)

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

参考になれば幸いです。

機能紹介

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

エクセルVBAの便利マクロ「選択した '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
   
      '*** VBAエラーコード
      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

まとめ

いかがでしたでしょうか。

参考になれば幸いです。

その他、エクセルマクロの便利ツールは以下記事を参照ください。

本稿で紹介したマクロのサポートやカスタマイズ、もしくは新規案件については、条件によって、有償にて対応受付しております。

以下、クラウドワークスないしココナラのアカウントよりご依頼いただければ幸いです。

FIRE太郎さん(その他)に依頼・外注する | 簡単ネット発注なら【クラウドワークス】
日本最大のクラウドソーシング「クラウドワークス」にご登録いただいているFIRE太郎さんのプロフィールです。その他のスキルを持つプロフェッショナルに1時間から仕事を気軽に発注!発注者は手数料無料。
FIRE太郎さん(会社員)のプロフィール | ココナラ
Excelマクロ(VBA)による自動化ツールの作成が得意です。|ブログ「FIRE(早期リタイア)研究所」運営中

コメント

タイトルとURLをコピーしました