excel - 从另一个表更新表值

Question

我有一个工作簿，其中有一个表，大小大约为 20000 行和 52 列。有时，我需要一次更新一定百分比的选定行。我希望使用宏根据行中的值更新选择的单元格，该值由第二个较小的表映射，更新后的值将输入到表 1 中。几乎类似于 VLOOKUP 函数，但它不如果未找到该条目，则不要删除该单元格。例如，根据主机 ID 更改电话号码。

我尝试使用下面代码中的数组来获取表 1 中的一组特定值，但我的值没有更新。我的 VBA 有点生疏，所以如果有人可以审查并协助使其正常运行，我将不胜感激。我想让它最终根据表头更新表中的任何条目。

Sub NewNameandCostCenter()
Dim myList, myRange
Dim sht As Worksheet
Dim sht2 As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Dim LastRow2 As Long
Set sht = Worksheets("NewNameMacro")
Set sht2 = Worksheets("ALL")
Set StartCell = Range("A2")

'Find Last Row and Column
  LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
  LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column
'set myList array
Set myList = sht.Range(StartCell, sht.Cells(LastRow, LastColumn))
LastRow2 = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'set myRange array
Set myRange = Sheets("ALL").Range("J2:M" & LastRow2)
'Update values of cells adjacent
For Each cel In myList.Columns(1).Cells
myRange.Replace What:=cel.Value, Replacement:=cel.Offset(0, 1).Value, LookAt:=xlWhole
myRange.Replace What:=cel.Value, Replacement:=cel.Offset(0, 2).Value, LookAt:=xlWhole
myRange.Replace What:=cel.Value, Replacement:=cel.Offset(0, 3).Value, LookAt:=xlWhole
Next cel
End Sub

谢谢，京东

Answer 1

如果我正确理解您的问题，那么您实际上是根据映射表中的值对数据运行 UPDATE 查询。

我假设如下:

• “关键”列是数据表和映射表中的第一列。

• 映射表中的列与数据表中的列的顺序和相对位置相同(尽管这可以轻松调整。

• 映射表和数据表中键的顺序是未排序的。如果您可以确保键已排序(最好在两个工作表中)，那么您可以通过一些细微的修改获得更好的性能。

我在示例中对范围进行了硬编码，但如果需要，您可以恢复最后一行和最后一列方法。

我已经完成了数组之间的所有比较，而不是范围之间的比较，并且我已经放弃了查找方法。您会发现这确实有效，而且效率更高。

Option Explicit

Sub NewNameandCostCenter()

  Dim start As Double
  start = Timer

  Dim countOfChangedRows As Long

  'set rngMap array
  Dim rngMap As Range
  Set rngMap = Worksheets("Map").Range("A1:D51")

  'set rngData array
  Dim rngData As Range
  Set rngData = Worksheets("Data").Range("J2:M20001")

  Dim aMap As Variant
  aMap = rngMap.Value

  Dim aData As Variant
  aData = rngData.Value

  Dim mapRow As Long
  Dim datarow As Long
  Dim mapcol As Long

  For mapRow = LBound(aMap, 1) To UBound(aMap, 1)
    For datarow = LBound(aData) To UBound(aData)
      'Check the key matches in both tables
      If aData(datarow, 1) = aMap(mapRow, 1) Then
        countOfChangedRows = countOfChangedRows + 1
        'Assumes the columns in map and data match
        For mapcol = LBound(aMap, 2) + 1 To UBound(aMap, 2)
          aData(datarow, mapcol) = aMap(mapRow, mapcol)
        Next mapcol
      End If
    Next datarow
  Next mapRow

  rngData.Value = aData

  Debug.Print countOfChangedRows & " of "; UBound(aData, 1) & " rows updated in " & Timer - start & " seconds"

End Sub

对于 50 个更新行，性能是合理的:

20000 行中的 50 行在 0.23828125 秒内更新

但是，如果您需要开始更新数千行，那么确保数据排序并相应地调整代码将使您受益匪浅。