在Vba中增加For循环中的变量?

Option Explicit

Public Sub mac()
Dim wsData As Worksheet, wsOutput As Worksheet
Dim rngInput As Range, RangeOfChild As Range, rngOutput As Range
Dim childCount As Long

    Set wsData = ThisWorkbook.Worksheets("SheetInput")
    Set wsOutput = ThisWorkbook.Worksheets("SheetOutput")
    Set rngInput = ThisWorkbook.Worksheets("SheetInput").Cells(1, 1)
    Set rngOutput = ThisWorkbook.Worksheets("SheetOutput").Cells(1, 1)

    While Not (IsEmpty(rngInput))
        Set RangeOfChild = Range(rngInput.Offset(0, 1), rngInput.End(xlToRight))
        childCount = RangeOfChild.Count
        rngInput.Copy
        rngOutput.PasteSpecial Paste:=xlPasteAll
        RangeOfChild.Copy
        rngOutput.Offset(0, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        Set rngInput = rngInput.Offset(1, 0)
        Set rngOutput = rngOutput.Offset(childCount, 0)
    Wend

End Sub

激活方法不好。使用变体数组。

Sub test()
    Dim rngDB As Range, rngCnt As Range
    Dim rng As Range, rng2 As Range
    Dim vCnt, vR()
    Dim i As Integer, c As Integer, n As Long, s As Long

    Set rngDB = Range("a1", Range("a" & Rows.Count).End(xlUp))
    For Each rng In rngDB
        Set rngCnt = Range(rng.Offset(, 1), rng.End(xlToRight))
        s = n + 1
        vCnt = rngCnt
        c = rngCnt.Columns.Count
        n = n + c
        ReDim Preserve vR(1 To 2, 1 To n)
        vR(1, s) = rng
        For i = 1 To c
            vR(2, s + i - 1) = vCnt(1, i)
        Next i
    Next rng
    Sheets.Add
    Range("a1").Resize(n, 2) = WorksheetFunction.Transpose(vR)

End Sub