VBA テスト データの比較 001

Sub 全角を半角へ変換()
    Dim LastRow As Long
    Dim i As Long
    
    ' Sheet2のA列の最終行を取得
    LastRow = ThisWorkbook.Sheets("貼り付け").Cells(Rows.Count, 1).End(xlUp).Row
    
    ' A列の各セルを処理
    For i = 1 To LastRow
        ThisWorkbook.Sheets("貼り付け").Cells(i, 1).Value = StrConv(ThisWorkbook.Sheets("貼り付け").Cells(i, 1).Value, vbNarrow)
    Next i
    
    Call データの比較とコピー
End Sub

Sub データの比較とコピー()
    Dim シート1 As Worksheet
    Dim シート2 As Worksheet
    Dim 最終行1 As Long
    Dim 最終行2 As Long
    Dim i As Long, j As Long
    Dim 一致フラグ As Boolean ' 一致した場合のフラグ
    
    ' シート1とシート2を設定
    Set Sh1 = ThisWorkbook.Sheets("スタート") ' シート1の名前を設定
    Set Sh2 = ThisWorkbook.Sheets("貼り付け") ' シート2の名前を設定
    
    ' シート1の最終行を取得
    最終行1 = Sh1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
    
    ' シート2の最終行を取得
    最終行2 = Sh2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
    
    ' シート1のA列の各セルを順番に比較
    For i = 1 To 最終行1
        一致フラグ = False ' 初期化
        
        ' シート2のA列の各セルと比較
        For j = 1 To 最終行2
            If Sh1.Cells(i, "A").Value = Sh2.Cells(j, "A").Value Then
                ' 一致した場合、シート2のB列にシート1のB列の値をコピー
                Sh2.Cells(j, "B").Value = Sh1.Cells(i, "B").Value
                一致フラグ = True ' 一致フラグをTrueに設定
            End If
        Next j
        
        ' 一致しなかった場合、何か特別な処理を行うことがあればここに記述
        If Not 一致フラグ Then
            ' 一致しなかった場合の処理を記述
        End If
    Next i
    
    ' メッセージボックスを表示
    MsgBox "データの比較とコピーが完了しました。", vbInformation
End Sub