VBA比较两张纸并替换纸张1中的值

我有两张表,sheet1和sheet2 .

我在sheet1中有17列,在sheet2中有14列 .

我在sheet1的L列中有ID(id以D2B和4开头) . 一个ID是11到13位长,而另一个是8位长 . 最后,我只需要D2B的ID .

在表2的L列中,我的ID仅以4开头,长度为8digit . 另外,我有A列只包含D2B .

我正在比较表1和shee2中的列(L) . 如果在sheet1中存在Id,则将结果复制到sheet2的M列 . 因为,我只需要D2B的Id,我检查表2的列L和M是否匹配,如果它们匹配,则我从列N中的表2的A列复制相应的ID d2B .

直到我已完成编码 .

现在,我想查看表1,它始于ID 4,并且发现它在sheet2中具有压缩的D2C Id,然后它应该被复制到sheet1的列M,如果没有找到,那么列的ID Sheet1中的L必须在M列中复制 . 任何人都可以指导我,我该怎么做

下面是代码,我用来检查sheet1中的值并在sheet2中粘贴 .

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

下面是代码,我用它来检查它们是否匹配并粘贴sheet2中相应的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

This is the sample screenshot of sheet1 and the result i am looking for

Is the Image of sheet2.

回答(1)

2 years ago

我在这个解决方案中整合了danieltakeshi的评论 . 它不是最有效的,但它很容易遵循,并显示了实现相同目的的两种方法 . 评论包含在代码中 . 在总体而言,我创建了许多变量:两个专用于每个工作表,一个用于搜索条件,两个用于确定L范围内的数据范围,两个用于测试每个范围中的数据,一个可变循环通过行和变量,以使用“查找”功能更改搜索条件 .

我已经设置了有用范围的限制,测试了匹配的信息片段,将D2C #s放在Sheet 2中,然后再回到Sheet 1中 . 我有些担心你的逻辑是自我复制而不需要,如果你'重新提取相同的信息两次...即,考虑重新思考该程序的组织方式 .

代码本身:

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