VBA快速合并更新数据

实例需求:Sheet1中的数据每日更新,Sheet2的数据为数据总表,现需要每天将Sheet1的数据更新至Sheet2中,如果Name+Color组合在Sheet2中已经存在,那么更新该行的Sales列数据,如果不是全新的数据,那么将该数据行追加到Sheet2数据表之后。

VBA快速合并更新数据_第1张图片

示例代码如下。

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行代码释放对象变量占用的系统资源。

你可能感兴趣的:(数据清洗,VBA,字典,合并数据,更新数据,数据排重,快速合并,数据合并)