从另一个表更新表值

时间:2016-08-05 17:46:28

标签: excel vba

我有一个工作簿,其中包含大约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

谢谢, JD

1 个答案:

答案 0 :(得分:2)

如果我正确理解您的问题,您将根据映射表中的值有效地针对您的数据运行UPDATE查询。

我假设了以下内容:

  • “key”列是映射表中数据表中的第一列。

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

  • 映射表和数据表中键的顺序未排序。如果您可以确保按键排序(理想情况下在两张纸上),那么只需稍作修改即可获得更好的性能。

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

我已完成数组之间的所有比较而不是范围,并且我已经完成了Find方法。你会发现这种方法有效,并且效率更高。

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

但是如果你需要开始更新数千行,那么你将从确保数据排序和相应调整代码中受益匪浅。