从另一个表中更新表值

我有一个大约20000行，52列的表的工作簿。 有时，我需要一次更新所选行的百分比。 我希望使用macros来更新基于行中的值的select单元格，由第二个更小的表格映射出来，并将更新后的值input到表1中。几乎就像一个VLOOKUP函数，如果没有find条目，则清除单元格。 例如，根据主机ID更改电话号码。

我试图用下面的代码中的一个数组做一下表1中的一组特定值，但是我的值没有更新。 我的VBA是有点生疏，所以如果有人可以审查和协助得到这个function，这将不胜感激。 我想使它最终根据表头更新表中的任何条目。

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 

谢谢，JD

Answer 1

如果我正确地理解了你的问题，那么根据映射表中的值，可以有效地运行对数据的UPDATE查询。

我假设如下：

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

• 映射表中的列与数据表中的列的顺序和相对位置相同（尽pipe这可以很容易地进行调整。

• 映射表和数据表中键的顺序是未sorting的。 如果你可以确保按键sorting（理想情况下在两张表中），那么你可以通过一些细微的修改来获得更好的性能。

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

我已经完成了所有的数组之间的比较，而不是范围，我已经完成了查找方法。 你会发现这个工作，并更有效地工作。

 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行是合理的：

50 of 20000 rows updated in 0.23828125 seconds

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