2枚のシートを比較し、シート1の値を置き換えるVBA

Question

シート1枚とシート2枚が2枚あります。

私はsheet1に17列あり、sheet2には14列あります。

私はsheet1の列LにIDを持っています（idはD2Bと4で始まります）。 1つのIDは11〜13桁のロングですが、もう1つは8桁のロングです。最後の結果では、私はD2BだけIDが必要です。

シート2の列Lには、IDが4から始まり、8digit Longです。また、D2Bのみを含むColumn Aを持っています。

私はシート1とshee2の両方の列（L）を比較しています。 Idがsheet1に存在する場合は、結果をsheet2のM列にコピーします。 D2BでIdだけ必要なので、シート2の列LとMが一致しているかどうかを確認します。一致している場合、列Nのシート2の列Aから対応するID d2Bをコピーします。

これまで私はコーディングを完了しました。

ID4で始まっているシート1を調べたいと思いますが、シート2に対応するD2C Idがあることが判明した場合は、sheet1のM列にコピーする必要がありますシート1の列LのIDを列Mにコピーする必要があります。どのように私がこれを行うことができますか。

以下は、シート1の値をチェックしてシート2に貼り付けるためのコードです。

Sub lookuppro() 
Dim totalrows As Long 
    Dim Totalcolumns As Long 
    Dim rng As range 

    totalrows = ActiveSheet.UsedRange.Rows.Count 
    Sheets("Sheet2").Select 
    For i = 1 To totalrows 
    Set rng = Sheets("Sheet1").UsedRange.Find(Cells(i, 12).Value) 
    'If it is found put its value on the destination sheet 

     If Not rng Is Nothing Then 
     Cells(i, 13).Value = rng.Value 
      End If 
     Next 
End Sub 

以下がコードです。これは、シート2の対応するD2C番号と一致して貼り付けられているかどうかを確認するためのコードです。

Sub match() 
Dim i    As Long 
    Dim lngLastRow  As Long 
    Dim ws    As Worksheet 

    lngLastRow = range("A1").SpecialCells(xlCellTypeLastCell).Row 

    Set ws = Sheets("Sheet2") 

    With ws 


     For i = 1 To lngLastRow 
      If .Cells(i, 12).Value = .Cells(i, 13).Value Then 
       .Cells(i, 14).Value = .Cells(i, 1).Value 

      Else 
      'nothing 
      End If 
     Next i 
    End With 
End Sub 

Answer 1

私は、このソリューションでdanieltakeshiからのコメントを統合しました。それは最も効率的ではありませんが、従うのは簡単で、同じ目的を達成する2つの方法を示しています。コメントはコードに含まれています。包括的な用語では、私はいくつかの変数を作成しました：2つは各シートに、1つは検索基準に、2つはL範囲のデータの範囲を、2つは各範囲のセルをテストするために、 Find関数を使用して検索基準を変更するための変数が含まれています。

有用な範囲の制限を設定し、一致する部分をテストしてD2C＃をシート2に入れてシート1に戻しました。私はあなたのロジックが同じ情報を2回抽出している場合、つまり、このプログラムの仕組みを再検討することを検討してください。

コード自体：

Sub check_values() 

Dim sh1 As Worksheet, sh2 As Worksheet 
Dim cell As Range, cell2 As Range, lstcl As Variant, lstcl2 As Variant, rgFnd As Variant 
Dim n As Double, ID As String 

Set sh1 = ThisWorkbook.Sheets(1) 
Set sh2 = ThisWorkbook.Sheets(2) 
ID = "4" 

lstcl = sh1.Range("L10000").End(xlUp).Row 
lstcl2 = sh2.Range("L10000").End(xlUp).Row 

'comparing columns L in both sheets 

For Each cell In sh2.Range("L1:L" & lstcl2) 
    For n = 1 To lstcl 
     If cell = sh1.Range("L" & n) Then 

      'the cell in column M next to the matching cell is equal to the 4xxxxxxx number 
      cell.Offset(0, 1) = sh1.Range("L" & n) 

      'the next cell in column N is equal to the D2C number in column A 
      cell.Offset(0, 2) = cell.Offset(0, -11) 

     End If 

    Next 
Next 

'test that each cell in the first sheet corresponds to the located results in the second sheet _ 
'and pastes back the D2C number, using the Range.Find function 

For Each cell2 In sh1.Range("L1:L" & lstcl) 
    If Left(cell2, 1) = ID Then 
     Set rgFnd = sh2.Range("M1:M" & lstcl2).Find(cell2.Value) 
      If Not rgFnd Is Nothing Then 
       cell2.Offset(0, 1) = sh2.Range(rgFnd.Address).Offset(0, 1) 
      End If 
    End If 
Next 


End Sub