Excelおさるくんのastro-notion-blog

Option Explicit

Sub ConvertToVerticalData()
    Dim LastRow As Long
    Dim LastCol As Integer
    Dim OutputRow As Long
    Dim i As Long, j As Integer
    Dim ws As Worksheet
    Dim wsOutput As Worksheet

    ' 元のデータが存在するワークシートを設定
    Set ws = ThisWorkbook.Sheets("Sheet1") 'シート名を必要に応じて変更してください
    ' 出力用のワークシートを設定
    Set wsOutput = ThisWorkbook.Sheets.Add
    wsOutput.Name = "Output"

    ' 元データの最終行と最終列を取得
    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    ' 出力データのヘッダーを設定
    wsOutput.Cells(1, 1).Value = ws.Cells(1, 1).Value
    wsOutput.Cells(1, 2).Value = "カテゴリ"
    wsOutput.Cells(1, 3).Value = "値"

    ' 出力データの最初の行を設定
    OutputRow = 2

    ' 元データをループして出力データを作成
    For i = 2 To LastRow
        For j = 2 To LastCol
            wsOutput.Cells(OutputRow, 1).Value = ws.Cells(i, 1).Value
            wsOutput.Cells(OutputRow, 2).Value = ws.Cells(1, j).Value
            wsOutput.Cells(OutputRow, 3).Value = ws.Cells(i, j).Value
            OutputRow = OutputRow + 1
        Next j
    Next i

End Sub

Option Explicit
Sub CorrectDateFormat()

    Dim LastRow As Long
    Dim i As Long
    Dim DateStr As String
    Dim CorrectedDate As Date
    Dim Arr() As String

    ' シート1をアクティブにします (必要に応じてシート名を変更してください)
    Sheets("Sheet1").Activate

    ' A列の最後の行を取得
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To LastRow ' 1行目はヘッダーなので、2行目から処理開始
        DateStr = Cells(i, 1).Value
        
        ' 年月日の文字を含む場合の変換
        If InStr(DateStr, "年") > 0 And InStr(DateStr, "月") > 0 Then
            DateStr = Replace(Replace(DateStr, "年", "/"), "月", "/")
            Arr = Split(DateStr, "/")
            If UBound(Arr) = 2 Then
                DateStr = Arr(0) & "/" & Arr(1) & "/" & Left(Arr(2), Len(Arr(2)) - 1) ' 日の後の「日」文字を除去
            End If
        End If
        
        On Error Resume Next
        CorrectedDate = DateValue(DateStr)
        On Error GoTo 0

        ' 日付が正しく変換された場合
        If IsDate(CorrectedDate) Then
            Cells(i, 2).Value = Format(CorrectedDate, "yyyy/mm/dd")
        Else
            ' 日付が変換できなかった場合、元の値をそのままB列にコピー
            Cells(i, 2).Value = DateStr
        End If
    Next i

End Sub