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

Posted 2023-03-27

【中文标题】VBA比较两张表并替换表1中的值

【英文标题】：VBA to compare two sheets and replace the value in sheet 1

【发布时间】：2017-11-30 15:46:20

【问题描述】：

我有两张 Sheets，sheet1 和 sheet2。

我在 sheet1 中有 17 列，在 sheet2 中有 14 列。

我在 sheet1 的 L 列中有 ID（ID 以 D2B 和 4 开头）。一个 ID 的长度为 11 到 13 位，而另一个 ID 的长度为 8 位。最后，我只需要 D2B 的 ID。

在表格 2 的 L 列中，我的 ID 仅以 4 开头。它是 8digit Long。另外，我有仅包含 D2B 的 A 列。

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

到此为止，我已经完成了编码。

现在，我想查看以 ID 4 开头的 sheet 1，发现它在 sheet2 中有对应的 D2C Id，则应将其复制到 sheet1 的 M 列，如果找不到，则sheet1 的 L 列 ID 必须复制到 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

以下是代码，我用于检查它们是否匹配并将相应的 D2C 编号粘贴到 sheet2 中。

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

【问题讨论】：

看看这个：***.com/questions/10714251/… 并避免使用 Select。所以你可以使用 Dim sht1, sht2 As Worksheet 在你的代码 Set sht1 = ThisWorkbook.Worksheets("Sheet1")

您可以检查第一个字符或前 3 个字符***.com/questions/34713100/… 并使用 For 公式搜索每一行，提取 ID 字符串的其余部分

@danieltakeshi 使用 left 我正在寻找第一个字符，如何将相应的值从 sheet2 替换为 sheet1？抱歉，我是 VBA 新手，这就是为什么？

@danieltakeshi 你能给我一个测试代码吗？可能是 ？我可以使用它

【参考方案1】：

我已将 danieltakeshi 的 cmets 集成到此解决方案中。它不是最有效的，但很容易理解并展示了两种实现相同目的的方法。注释包含在代码中。总体而言，我创建了许多变量：两个专用于每个工作表，一个用于搜索条件，两个用于确定 L 范围内的数据范围，两个用于测试每个范围内的单元格，一个用于循环遍历的变量行和变量以使用 Find 函数更改搜索条件。

我已经设置了有用范围的限制，测试了匹配的信息以将 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

【讨论】：

感谢您帮助我解决问题。我只有一个担心。使用 range.find 将所有等效的 D2C 粘贴到 sheet1 的 M 列中。早些时候我有一些 D2C 的 L 列和 4 的 ID，现在列 M 具有来自 sheet2 的列 L 的等效 D2C，在 N 列中，我希望从两个列中获得合并的唯一 D2C 编号。我也在我的图片中展示了它。你能建议我怎么做这个方法吗？

没问题，很高兴能帮上忙。您只需编辑代码即可将第一列中的任何 D2C 标识符粘贴到相邻单元格中，从而获得此类数据的合并列表。

如果我有任何疑问，我会尝试并回复您。 @正交