VBA快速合并多列单元格
实例需求：工作表中第3行到第5行有如下图所示的数据表，为了方便展示，隐藏了部分列，实际数据为从C列到DO列。
现需要合并第3行和第4行相同内容的单元格，如第10行到第12行所示。
示例代码如下。
Sub MergeDemo()Dim dicMth As Object, dicYr As Object, rngData As RangeDim i As Long, iYr As String, iMth As String, vKeyDim arrDataConst START_COL = 3Sheet2.Copy after:=Sheets(Sheets.Count)Set dicMth = CreateObject("scripting.dictionary")Set dicYr = CreateObject("scripting.dictionary")Set rngData = Range("A3").CurrentRegionarrData = rngData.ValueFor i = START_COL To UBound(arrData, 2)iYr = CStr(arrData(1, i))iMth = arrData(1, i) & "|" & arrData(2, i)UpdateDic dicYr, iYr, 3, iUpdateDic dicMth, iMth, 4, iNext iApplication.DisplayAlerts = FalseIf dicYr.Count > 0 ThenFor Each vKey In dicYr.KeysdicYr(vKey)(0).Resize(1, dicYr(vKey)(1)).MergeNextEnd IfIf dicMth.Count > 0 ThenFor Each vKey In dicMth.KeysdicMth(vKey)(0).Resize(1, dicMth(vKey)(1)).MergeNextEnd IfApplication.DisplayAlerts = True
End Sub
【代码解析】
第5行代码指定表格的起始列。
第6行代码将Sheet2复制到最后位置，合并表格将在此工作表中进行。
第7~8行代码创建两个字典对象。
第9行代码将数据表格读取到数组中。
第11~16行代码循环遍历数组。
第12行代码获取数组中第一行的年。
第13行代码获取数组中第2行的月，并在之前添加年字符串。
第14~15行代码调用UpdateDic过将数据添加到字典对象中。
第17行代码屏蔽合并单元格时的警告信息。
第18行代码判断dicYr对象是否为空。
第19~21行代码循环遍历dicYr对象。
第20行代码合并指定单元格区域。
dicYr(vKey)(0)为字典值数组中的第一个元素，是一个Range对象dicYr(vKey)(1)为相同内容的单元格的个数
第23~27行代码使用类似的方式合并月份单元格。
第28行代码恢复显示系统警告信息。
Sub UpdateDic(ByRef oDic As Object, vKey, iRow, iCol)Dim aTmp(1), aTmp2If oDic.exists(vKey) ThenaTmp2 = oDic(vKey)aTmp2(1) = aTmp2(1) + 1oDic(vKey) = aTmp2ElseSet aTmp(0) = Cells(iRow, iCol)aTmp(1) = 1oDic(vKey) = aTmpEnd If
End Sub
【代码解析】
第1行代码声明Sub过程，其中有4个参数：
- oDic为字典对象
- vKey为键值
- iRow为单元格的行号
- iCol为单元格的列号
第3行代码判断字典对象中是否存在键值vKey。
如果存在，第4行代码读取字典对象中的值（包含两个值的一维数组）。
第5行代码更新数组中的第二个元素，累加1。
第6行代码更新字典中的值（数组）。
如果不存在，第8行代码将单元格赋值给元素的第一个元素。
第9行代码设置数组第二个元素为1。
第10行代码将键值对保存到字典对象中。
此示例中使用数组保存单元格引用和相同单元格的个数，也可以使用嵌套数组实现。