Excel VBA，如何使用条件将单元格/单元格从工作表 1 复制到工作表 2

Question

我有两张纸，发票和客户。 在发票表上，当我在单元格 A11 中写入客户姓名时，客户的其余信息出现在 A12 到 A15 中。 但是，我想从发票表中更改此信息并将其复制到客户表上。 我的代码适用于客户。 但我需要为每个客户提供此代码。 我需要你的想法，拜托

    Private Sub Worksheet_Change(ByVal Target As Range)

    Set sh1 = ThisWorkbook.Sheets("Customer")
    Set sh4 = ThisWorkbook.Sheets("Invoice")
    
    If Not Intersect(Target, sh4.Range("A12:A15")) Is Nothing Then
        If sh4.Range("A11").Value = sh1.Range("B2").Value Then
            sh1.Range("F2").Value = sh4.Range("A12").Value
            sh1.Range("G2").Value = sh4.Range("A13").Value
        End If
    End If
    
   End Sub

Answer 1

您可以使用字典实现这种“匹配时更改”。

Option Explicit

    Sub DictMatch()
        Dim dict As Object, sh1 As Worksheet, sh4 As Worksheet 'you should declare your vars
        Set dict = CreateObject("Scripting.Dictionary") 'create dictionary lateB
        Set sh1 = ThisWorkbook.Sheets("Customer") 'adds no value, you could just use Sheet1
        Set sh4 = ThisWorkbook.Sheets("Invoice") 'adds no value, you could just use Sheet4
        
        Dim arr, arr2, LastRowSh1 As Long, LastRowSh4 As Long
        LastRowSh1 = sh1.Cells(sh4.Rows.Count, "B").End(xlUp).Row 'count rows from last row
        LastRowSh4 = sh4.Cells(sh4.Rows.Count, "A").End(xlUp).Row 'count rows from last row
         
        arr = sh4.Range(sh4.Cells(1, 1), sh4.Cells(LastRowSh4, 1)).Value2 'load col A of invoices
        arr2 = sh1.Range(sh1.Cells(1, 2), sh1.Cells(LastRowSh1, 7)).Value2 'load col B to G of cust
        
        Dim j As Long
        With dict 'used because I'm to lazy to retype dict everywhere :)
            .CompareMode = 1 'textcompare
            For j = 1 To UBound(arr) 'traverse invoices
                If Not .Exists(arr(j, 1)) Then 'set key if I don't have it yet in dict
                    .Add Key:=arr(j, 1), Item:=j
                End If
            Next j
            
            For j = 1 To UBound(arr2) 'traverse customers
                If .Exists(arr2(j, 1)) Then 'matching happens here, compare data from target with dictionary
                    arr2(j, 5) = arr(dict(arr2(j, 1)) + 1, 1) 'write to target array if match
                    arr2(j, 6) = arr(dict(arr2(j, 1)) + 2, 1) 'we could make this more dynamic if you have more rows
                End If
            Next j
        End With
        With sh1
            .Range(.Cells(1, 2), .Cells(LastRowSh1, 7)) = arr2 'dump updated array to customer sheet
        End With
    End Sub

根据您的输入，它应该可以在不进行更改的情况下执行您想要的操作，但是如果您遇到任何问题，请告诉我。 如果没有，请接受为“答案”。

一些想法：

• 最好的做法是在代码的顶部添加“选项显式”，这将迫使您声明所有变量，这将在某一天为您省去很多麻烦:)。
• 尽管您可以将此代码粘贴到相交中，但我建议将其添加到“保存”事件（或按钮）中。 否则，每次编辑字段时都会运行完整代码而没有任何附加值。