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