Question

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

两个格式化的表格看起来都像uniqueID | ssn | ...，并按uniqueID排序。源A不会导出社会安全号码，因此表A的ssn列为空。来源B确实输出社会安全号码。我想使用表B中的数据和ssn作为关键字填写表A的uniqueID列。

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

人员（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），这些工作表符合我对您所拥有的表类型的理解：

Sheet A before macro

Sheet B

在宏之后，工作表SheetA看起来像这样：

Sheet A after the macro

我的整个代码如下。它与我的测试数据一起正常运行，但我还没有用尽它。

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

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

1 个答案: