文字列を抽出するマクロ

Sub CopyDatesToCell()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dateList As String
    Dim i As Long
    
    ' 対象のシートを設定
    Set ws = ThisWorkbook.Sheets("欲しいリスト") ' シート名を適切なものに変更
    
    ' B列の最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' 日付を転記するための文字列を初期化
    dateList = ""
    
    ' B列をループして日付をH5セルに転記
    For i = 1 To lastRow
        If ws.Cells(i, "B").Value = "B9491" Then
            ' 該当するセルが見つかった場合、日付を取得してdateListに追加
            If dateList = "" Then
                dateList = Format(ws.Cells(i, "A").Value, "mmdd")
            Else
                dateList = dateList & "・" & Format(ws.Cells(i, "A").Value, "d")
            End If
        End If
    Next i
    
    ' H5セルに日付を転記
    ws.Range("H5").Value = dateList
End Sub