Question

我对VBA的知识有限，并且大多数VBA编码都是通过复制和粘贴其他代码或通过录制来完成的。因此，对于没有显示自己的任何代码，我深表歉意。这是我的问题，我需要打开它：

Column   A   |    B   |     C      |     D      |    E
      random  random 2  Transpose 1 Transpose 2
      random  random 2  Transpose 3 Transpose 4  Transpose 5

进入此

 Column   A   |    B   |     C      |     D      |    E
      random  random 2 
              Transpose 1 
              Transpose 2
      random  random 2  
              Transpose 3 
              Transpose 4  
              Transpose 5

从本质上讲，我有很多行的数据都从C列开始，需要通过插入新行以匹配数据条目的数量，将这些数据转置到它原来所在的行的下方。有没有一种方法可以通过VBA代码自动执行此操作？如果可能的话，请附上每条编码行的说明，以便我继续学习。

Answer 1

也许您想要这样的东西。我对其进行了两次测试，它似乎可以正常工作，并给了我您问题中所显示的内容（但可能在某些情况下它会失败）

Option Explicit

Private Sub CustomTranspose()

    ' Understanding this "With" statement is not crucial. We use it mainly for convenience. '
    ' The main thing to note is that we specify what our input is '
    ' and where we want the output to be written to. '
    With ThisWorkbook

        ' Assumes the range you want to work with is on range "A1:E2" on sheet "Sheet1" '
        ' First we read the values into an array. '
        Dim inputArray() As Variant
        inputArray = .Worksheets("Sheet1").Range("A1:M3").Value2

        ' Assumes the range, to which you want to write the "transposed" values,
        ' begins at cell "A1" of sheet "Sheet2"
        Dim firstOutputCell As Range
        Set firstOutputCell = .Worksheets("Sheet2").Range("A1")

    End With

    Dim rowIndex As Long
    Dim columnIndex As Long
    Dim writeIndex As Long
    writeIndex = -1 ' We want it to be 0 after the first increment.

    ' Here we loop over the array (from first row to last row) '
    ' The Lbound and Ubound functions below are just ways of getting the start and end of the array '
    For rowIndex = LBound(inputArray, 1) To UBound(inputArray, 1)

        writeIndex = writeIndex + 1
        ' Copy the first two columns exactly as they are '
        ' We do not need a loop for this, but I use one below anyway'
        For columnIndex = 1 To 2
            firstOutputCell.Offset(writeIndex, columnIndex - 1).Value2 = inputArray(rowIndex, columnIndex)
        Next columnIndex

        ' Loop through the remaining columns (of this row) and write them '
        ' to a new row in column 2 -- effectively transposing them '
        For columnIndex = columnIndex To UBound(inputArray, 2)
            If IsEmpty(inputArray(rowIndex, columnIndex)) Then
                Exit For ' If a blank cell is encountered, we stop looping through the columns and move on to the next row.
            End If
            writeIndex = writeIndex + 1
            firstOutputCell.Offset(writeIndex, 1).Value2 = inputArray(rowIndex, columnIndex)
        Next columnIndex

    Next rowIndex

End Sub

我的答案中的注释多于代码，但是如果您仍然无法遵循某些内容，请留下注释或其他内容，我会尽力解释。

在提问时显示您的代码/努力总是很好的。

转置数据并插入行-Excel VBA

1 个答案: