EXCEL VBA：如何使用 VBA 交错行

Question

基本上就是标题中所说的。我运气不太好，所以如果您能提供任何意见，我们将不胜感激，谢谢！

按 B 列分组，B 中匹配单元格的数量决定插入多少个空格。

之前：

之后：

任何帮助将不胜感激，谢谢！

Answer 1

• 使用Dictionary对象来合并每个组的数据

微软文档：

集合对象

Range.Resize 属性 (Excel)

Range.CurrentRegion 属性 (Excel)

Option Explicit

Sub Demo()
    Dim objDic As Object, objDicCnt As Object, rngData As Range
    Dim i As Long, sKey, arrData, arrRes, iR As Long, aTxt
    Set objDic = CreateObject("scripting.dictionary")
    Dim oSht As Worksheet
    Set oSht = Sheets("Sheet10")  ' modify as needed
    ' load data into array
    Set rngData = oSht.Range("A1").CurrentRegion
    arrData = rngData.Value
    ' consolidate group data
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = arrData(i, 1) & "|" & arrData(i, 2)
        If Not objDic.exists(sKey) Then
            Set objDic(sKey) = New Collection
        End If
        objDic(sKey).Add arrData(i, 3)
    Next i
    Dim iCnt As Long
    ReDim arrRes(1 To UBound(arrData) * 3, 1 To 3)
    Sheets.Add
    ' copy header row
    oSht.Rows(1).Copy ActiveSheet.Range("A1")
    ' loop through group to populate output array
    For Each sKey In objDic.Keys
        aTxt = Split(sKey, "|")
        iCnt = objDic(sKey).Count
        For i = 1 To iCnt
            iR = iR + 1
            arrRes(iR, 1) = aTxt(0)
            arrRes(iR + iCnt, 2) = aTxt(1)
            arrRes(iR + iCnt * 2, 3) = objDic(sKey)(i)
        Next
        iR = iR + 2 * iCnt
    Next
    ' write output to sheet
    Range("A2").Resize(iR, 3) = arrRes
'    ActiveSheet.UsedRange.EntireColumn.AutoFit
    Set objDic = Nothing
End Sub