0

请帮助一个新手，我就是无法解决这个问题。变得困惑。

我有一个带有 2 个工作表的工作簿。

两个工作表中的 A 列是零件编号代码。

两个工作表中的 B 列是 A 列中部件号的折扣代码。

两个工作表中的 C 列是零件编号取代（新零件编号）列，但并非所有行在 C 列中都有新零件编号，C 列中的一些单元格为空。

新的零件编号列 C 没有在 D 列中填充任何折扣代码。

我的目标是用从 B 列中找到的相关折扣代码填充两个工作表中的 D 列，但仅针对 C 列中实际填充了零件号的每个单元格，同时查看工作表 1 和工作表 2。

工作表1

工作表2

到目前为止，我在以下方面取得的成功很少，但我只是触及表面，相信一些 VBA 将是一个更好的解决方案，但我非常迷茫。

=XLOOKUP(D2,Sheet1!A:A & Sheet2!A:A,B:B,0,1)

这段代码不是一个完整的公式，只是部分工作。

请帮忙。谢谢你。

4

1 回答 1

1

使用字典对象作为查找表

Option Explicit

Sub macro1()

    Dim ws As Worksheet
    Dim lastrow As Long, i As Integer, r As Long
    Dim dict As Object, key, n As Long

    Set dict = CreateObject("Scripting.Dictionary")
    ' build look up from sheet 1 and 2
    For i = 1 To 2
        Set ws = Sheets(i)
        lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
        For r = 1 To lastrow
           key = Trim(ws.Cells(r, "A"))
           If dict.exists(key) Then
               MsgBox "Duplicate Part No '" & key & "'", vbCritical, "Row " & r
               Exit Sub
           Else
               dict.Add key, ws.Cells(r, "B")
           End If
        Next
    Next
   
    ' update col D on both sheets
    For i = 1 To 2
        Set ws = Sheets(i)
        lastrow = ws.Cells(Rows.Count, "C").End(xlUp).Row
        For r = 1 To lastrow
           key = Trim(ws.Cells(r, "C"))
           If Len(key) > 0 Then
               If dict.exists(key) Then
                    ws.Cells(r, "D") = dict(key)
                    n = n + 1
                End If
            End If
        Next
    Next
    MsgBox n & " rows updated", vbInformation

End Sub
于 2021-09-17T20:43:21.677 回答