优化交叉填充缺失数据的方法

Question

我有两张来自不同来源的同一公司员工的人口统计数据表。在应用相同的格式并对每个表进行排序后，某些列是空白的，因为该源没有导出该数据。

两个表格的格式都类似于uniqueID | ssn | ...，并按uniqueID 排序。源 A 不导出社会保障号，因此表 A 的 ssn 列是空白的。来源 B 确实导出了社会安全号码。我想用表B中的数据和uniqueID作为键填写表A的ssn列。

对我而言，社会安全号码也是一个唯一 ID，因此永远不会有一个 ssn 与两个唯一 ID 配对，反之亦然。

人员 (uniqueID | ssn) 可以在同一张桌子上出现多次，并且在不同的桌子上出现不同的次数。有些人可能在一张桌子上而不是另一张桌子上。

我目前在 VBA 中的解决方案是，

Function crossFillMissingDemos( tableA as Range, tableB as Range)
    Dim crntID As Variant: crntID = tableB.Cells(1,"A").Value
    For Each demoB In tableB.Rows
        If crntID <> demoB.Cells(1, "A").Value Then
            crntID = demoB.Cells(1, "A").Value
            For Each demoA In tableA.Rows
                If demoA.Cells(1, "A").Value = crntID Then
                    demoA.Cells(1,"B").Value = demoB.Cells(1,"B").Value   
                End If
            Next demoB
        End If
    Next demoB 
Exit Function

随着表大小的增加，它会变慢，因为它有 tableB.personCount * tableA.RowCount 操作。

是否有更多方法可以优化此功能或更好的方法？

Answer 1

我不明白你的代码。在第二行，您使用 demoB 作为预定义范围，而在第三行，您将其用作 For-Next 循环变量。 crntID = demoB.Cells(1,"A").Value 应该在循环内吗？

您说这两个表按相同的顺序排序，所以我不明白嵌套 For-Next 循环的使用。您需要做的就是降低匹配和复制值的两个表。这需要 TableA.Rows.Count + TableB.Rows.Count 步骤；注：加不倍。在我的代码中，我采取了将范围值复制到数组的附加步骤，这将使代码更快一些。我使用 Debug.Print 来显示地址和数组边界，因为值可能不是您所期望的。

我创建了两个工作表（SheetA 和 SheetB），它们符合我对您所拥有的表格类型的理解：

在宏之后，工作表 SheetA 如下所示：

我的整个代码如下。它与我的测试数据一起正常运行，但我没有对它进行彻底的测试。

Option Explicit
Sub CallCrossFillMissingDemos()

  Dim ColShtAMax As Long
  Dim ColShtBMax As Long
  Dim RngA As Range
  Dim RngB As Range
  Dim RowShtAMax As Long
  Dim RowShtBMax As Long

  With Worksheets("SheetA")
    ColShtAMax = .UsedRange.Columns.Count
    RowShtAMax = .UsedRange.Rows.Count
    Set RngA = Worksheets("SheetA").Range(.Cells(2, 1), _
                                          .Cells(RowShtAMax, ColShtAMax))
  End With
  With Worksheets("SheetB")
    ColShtBMax = .UsedRange.Columns.Count
    RowShtBMax = .UsedRange.Rows.Count
    Set RngB = Worksheets("SheetB").Range(.Cells(2, 1), _
                                          .Cells(RowShtBMax, ColShtBMax))
  End With

  Call crossFillMissingDemos(RngA, RngB)

End Sub
Function crossFillMissingDemos(ByVal tableA As Range, ByVal tableB As Range)

   Debug.Print "Table A is " & tableA.Worksheet.Name & ".Range(" & tableA.Address & ")"
   Debug.Print "Table B is " & tableB.Worksheet.Name & ".Range(" & tableB.Address & ")"

   Dim IdACrnt As String
   Dim IdBCrnt As String
   Dim RowACrnt As Long
   Dim RowBCrnt As Long
   Dim SSNCrnt As String
   Dim TableAValues As Variant
   Dim TableBValues As Variant

   ' Copy values from ranges to arrays
   TableAValues = tableA.Value
   TableBValues = tableB.Value

   Debug.Print "TableAValues(" & LBound(TableAValues, 1) & " To " & _
               UBound(TableAValues, 1) & ", " & LBound(TableAValues, 2) & _
               " To " & UBound(TableAValues, 2) & ")"
   Debug.Print "TableBValues(" & LBound(TableBValues, 1) & " To " & _
               UBound(TableBValues, 1) & ", " & LBound(TableBValues, 2) & _
               " To " & UBound(TableBValues, 2) & ")"
   ' Note: although the ranges start from row 2, the arrays start from 1.
   ' Whatever range you load to an array, the top left cell will be (1, 1)

   ' Initialise control variables
   RowACrnt = 1
   IdACrnt = TableAValues(RowACrnt, 1)
   RowBCrnt = 1
   IdBCrnt = TableBValues(RowBCrnt, 1)
   SSNCrnt = TableBValues(RowBCrnt, 2)

   ' Loop down arrays copying SSNs from array copy of TableB
   ' to array copy of TableA as appropriate
   Do While True
     If IdACrnt = IdBCrnt Then
       ' Rows are for same person.  Copy SSN to Table A
       TableAValues(RowACrnt, 2) = SSNCrnt
       RowACrnt = RowACrnt + 1
       If RowACrnt <= UBound(TableAValues, 1) Then
         IdACrnt = TableAValues(RowACrnt, 1)
       Else
         ' All rows in Table A have been processed
         Exit Do
       End If
     ElseIf IdACrnt < IdBCrnt Then
       ' IdACrnt is not present in TableB
       RowACrnt = RowACrnt + 1
       If RowACrnt <= UBound(TableAValues, 1) Then
         IdACrnt = TableAValues(RowACrnt, 1)
       Else
         ' All rows in Table A have been processed
         Exit Do
       End If
     Else
       ' IdACrnt > IdBCrnt
       ' If this person is present in TableB, they are further down table
       RowBCrnt = RowBCrnt + 1
       If RowBCrnt <= UBound(TableBValues, 1) Then
        SSNCrnt = TableBValues(RowBCrnt, 2)
         IdBCrnt = TableBValues(RowBCrnt, 1)
       Else
         ' All rows in Table B have been processed
         Exit Do
       End If
     End If
   Loop

   ' Copy Updated TableAValues back to range
   tableA.Value = TableAValues

End Function