生徒：「先生、このコードは何してるんですか？」
先生：「このコードは、いくつかの作業を自動でやってくれるもんやけど、簡単に言うと、シート間でデータをチェックして、条件に合わせてデータを転記するもんやで。」
生徒：「『SetValuesBasedOnCondition』ってどんなことをしてるんですか？」
先生：「これは、A列のデータを見て、もし『サンプル1』やったらN、O、P列にそれぞれA、B、Cをセットして、もし『サンプル』やったらN、O、P列にそれぞれD、E、Fをセットするんや。」
生徒：「次に、『CheckAndTransferDataWithVLookup』って何をしてるんですか？」
先生：「これは、シート1のA列のデータをシート2のA列と照らし合わせて、見つかったらVLOOKUPでデータを取得して、シート1のN、O、P列に転記するもんや。」
生徒：「最後の『CheckAndTransferData』はどうですか？」
先生：「これはシート1のA列のデータを、シート2のA列と照らし合わせて、一致したらシート2のB列の値をシート1のP列に転記するんや。N、O列にはそれぞれA、Bをセットするで。」
生徒：「なるほど！どれもシート間でデータをチェックして、条件に合ったら転記してるんですね！」
先生：「その通り！それぞれ少しずつやり方が違うけど、基本的にはデータを探して、見つかったら必要な情報を転記するってことをしてるんや。」
Sub SetValuesBasedOnCondition()
Dim rng As Range
Dim cell As Range
Dim lastRow As Long
' 列Aの最終行を取得
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
' チェックする範囲を最終行まで設定
Set rng = Range("A1:A" & lastRow)
' 範囲内のセルをループ
For Each cell In rng
If cell.Value = "サンプル1" Then
cell.Offset(0, 13).Value = A ' N列にAをセット
cell.Offset(0, 14).Value = B ' O列にBをセット
cell.Offset(0, 15).Value = C ' P列にCをセット
ElseIf cell.Value = "サンプル" Then
cell.Offset(0, 13).Value = D ' N列にDをセット
cell.Offset(0, 14).Value = E ' O列にEをセット
cell.Offset(0, 15).Value = F ' P列にFをセット
End If
Next cell
End Sub
Sub CheckAndTransferDataWithVLookup()
Dim wsSource As Worksheet ' 作業シート（Sheet1）
Dim wsList As Worksheet ' 互換リストシート（Sheet2）
Dim rngSource As Range ' 作業シートの範囲
Dim cell As Range
Dim result As Variant
' シート1（作業シート）とシート2（互換リスト）の設定
Set wsSource = ThisWorkbook.Sheets("Sheet1") ' シート1の名前を指定
Set wsList = ThisWorkbook.Sheets("Sheet2") ' シート2の名前を指定
' 作業シートの最終行を取得
Dim lastRowSource As Long
lastRowSource = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
Set rngSource = wsSource.Range("A1:A" & lastRowSource) ' A列の範囲
' 作業シートの各セルをループ
For Each cell In rngSource
' 互換リストからVLOOKUPで値を取得
On Error Resume Next
result = Application.VLookup(cell.Value, wsList.Range("A:B"), 2, False) ' A列からB列を検索
On Error GoTo 0
' VLOOKUPで一致する値が見つかった場合
If Not IsError(result) Then
' N列に3、O列に0、P列にVLOOKUPで取得した値を転記
wsSource.Cells(cell.Row, 14).Value = A ' N列にAをセット
wsSource.Cells(cell.Row, 15).Value = B ' O列にBをセット
wsSource.Cells(cell.Row, 16).Value = result ' P列にVLOOKUP結果を転記
End If
Next cell
End Sub
Sub CheckAndTransferData()
Dim wsSource As Worksheet ' 作業シート（シート1）
Dim wsList As Worksheet ' 互換リストシート（シート2）
Dim rngSource As Range ' 作業シートの範囲
Dim rngList As Range ' 互換リストの範囲
Dim cell As Range
Dim matchRow As Long
' シート1（作業シート）とシート2（互換リスト）の設定
Set wsSource = ThisWorkbook.Sheets("Sheet1") ' シート1の名前を指定
Set wsList = ThisWorkbook.Sheets("Sheet2") ' シート2の名前を指定
' 作業シートの最終行を取得
Dim lastRowSource As Long
lastRowSource = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
Set rngSource = wsSource.Range("A1:A" & lastRowSource) ' A列の範囲
' 互換リストシートの最終行を取得
Dim lastRowList As Long
lastRowList = wsList.Cells(wsList.Rows.Count, 1).End(xlUp).Row
Set rngList = wsList.Range("A1:A" & lastRowList) ' 互換リストのA列の範囲
' 作業シートの各セルをループ
For Each cell In rngSource
' 互換リスト内で一致する値を検索
matchRow = 0 ' 一致する行が見つからなければ0を返す
On Error Resume Next
matchRow = Application.Match(cell.Value, rngList, 0) ' 一致する値を検索
On Error GoTo 0
' 一致する値が見つかった場合
If matchRow > 0 Then
' 互換リストの該当行から値を取得して転記
wsSource.Cells(cell.Row, 14).Value = A ' N列にAをセット
wsSource.Cells(cell.Row, 15).Value = B ' O列にBをセット
wsSource.Cells(cell.Row, 16).Value = wsList.Cells(matchRow, 2).Value ' P列に互換リストの2列目の値を転記
End If
Next cell
End Sub
