实例需求:Sheet1中的数据每日更新,Sheet2的数据为数据总表,现需要每天将Sheet1的数据更新至Sheet2中,如果Name+Color组合在Sheet2中已经存在,那么更新该行的Sales列数据,如果不是全新的数据,那么将该数据行追加到Sheet2数据表之后。
示例代码如下。
Sub demo()
Dim srcSht As Worksheet, desSht As Worksheet
Dim arrDes, arrSrc, arrRes()
Dim objDic, arrItem, sKey As String
Dim i As Long, j As Long, ColCnt As Long
Const KEY_COL_CNT As Integer = 2
Const SEP_CHAR = "|"
Set srcSht = Sheets("Sheet1")
Set desSht = Sheets("Sheet2")
arrSrc = srcSht.[a1].CurrentRegion.Value
arrDes = desSht.[a1].CurrentRegion.Value
ColCnt = UBound(arrDes, 2)
Set objDic = CreateObject("scripting.dictionary")
For i = 1 To UBound(arrDes)
sKey = ""
For j = 1 To KEY_COL_CNT
sKey = sKey & SEP_CHAR & arrDes(i, j)
Next
objDic(sKey) = Application.Index(arrDes, i)
Next
For i = 1 To UBound(arrSrc)
sKey = ""
For j = 1 To KEY_COL_CNT
sKey = sKey & SEP_CHAR & arrSrc(i, j)
Next
objDic(sKey) = Application.Index(arrSrc, i)
Next
ReDim arrRes(objDic.Count - 1, 1 To ColCnt)
arrItem = objDic.items
For i = LBound(arrItem) To UBound(arrItem)
For j = 1 To ColCnt
arrRes(i, j) = arrItem(i)(j)
Next j
Next i
desSht.Range("A1").Resize(objDic.Count, ColCnt) = arrRes
Set objDic = Nothing
End Sub
【代码解析】
第6行代码声明常量,指明关键字段共两列,即A列和B列。
第7行代码声明常量,指定分隔符为竖线。
第8~9行代码获取源工作表和目标工作表对象。
第10~11行代码获取源工作表和目标工作表中的数据表Range对象。
第12行代码获取数据表的总列数。
第13行代码创建字典对象。
第14~20行代码将目标工作表数据表加载到字典对象中。
第16~18行代码构建字典的键,为了是代码具备更好的通用性,此处使用循环语句,在本示例中可用直接使用如下代码。
sKey = arrDes(i, 1) & SEP_CHAR & arrDes(i, 2)
第19行代码使用工作表函数Index
将数组保存到字典中。
第21~27行代码将源工作表数据表加载到字典对象中。
注意此处需要先加载目标工作表数据,然后再加载源工作表数据,这样才能够实现对已经存在的Name+Color组合更新Sales数据。
第28行代码为arrRes数组分配空间,用于保存结果数据。
第29行代码提取字典对象的值,其结果为一个数组。
第30~34行代码为嵌套循环提取结果表的数据。
第35行代码将结果更新到目标工作表。
第36行代码释放对象变量占用的系统资源。