Question

我有一个庞大的数据集，其中包含多项选择题，必须对其进行排序。每个问题由一组10行组成，必须将其转换为10列。现在该工作表为1100行，我将不得不使用其他16个相同格式的工作表进行此操作。

我通过记录导致以下代码行的必要操作在Excel中创建了一个宏：

    Selection.End(xlDown).Select
Range("C21:C26").Select
Selection.Copy
Range("C19").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
    , Transpose:=True
Rows("21:31").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("B27").Select
End Sub

现在，我需要宏中的变量来使每次迭代更改+1，所以下一次迭代看起来像这样。

    Selection.End(xlDown).Select
Range("C22:C27").Select
Selection.Copy
Range("C20").Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
    , Transpose:=True
Rows("22:32").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("B28").Select
End Sub

我完全被困在那里。非常感谢您的帮助！非常感谢。

Answer 1

所以我不清楚您的行数。

您也许可以按以下方式使用数组（请确保备份工作表，因为这会清除工作表中的数据）

Option Explicit
Public Sub Test()
    Dim startRow As Long, endRow As Long, rng As Range, arr(), outputArr(), i As Long
    startRow = 21
    endRow = 1100

    With ThisWorkbook.Worksheets("SheetA") '<== Change as required
        Set rng = .Range("C" & startRow & ":C" & endRow)
        arr = rng.Value
        arr = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(arr, 0, 1))
        ReDim outputArr(1 To 5, 1 To Application.WorksheetFunction.RoundUp(UBound(arr, 1) / 5, 0))

        outputArr = Application.WorksheetFunction.Transpose(outputArr)
        Dim counter As Long, counter2 As Long
        counter2 = 1
        For i = LBound(arr) To UBound(arr) Step 12
            For counter = 0 To 4
                outputArr(counter2, counter + 1) = arr(i + counter)
            Next
            counter2 = counter2 + 1
        Next

        rng.ClearContents
        .Range("C19").Resize(UBound(outputArr, 1), UBound(outputArr, 2)) = outputArr
    End With
End Sub

在宏VBA中调整每次迭代的范围

1 个答案: