Question

我有两张表，即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，如果没有找到，那么必须在第M列中复制sheet1的列L的ID。任何人都可以指导我，我该怎么做

下面是代码，我用来检查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

Answer 1

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

我已经设置了有用范围的限制，测试了匹配的信息片段，将D2C #s放入工作表2，然后再返回到工作表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

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

1 个答案: