Question

数据分布在各列

想要保持前三列固定（列a，b和c）。

然后将列从4开始转换为新行（列d - >最后一列有值）。

实施例：

列D - >向前的颜色并不总是绿色，蓝色，黑色等......它们根据从电源查询表中加载的数据而有所不同。

这就是我希望数据显示的方式：

注意列A，B和C是如何用相同的信息修复的，只有D列以后才重新创建一个新的“行”。

我一直在努力调整之前帖子中的VBA脚本，但是我遇到了一些复杂问题。我也试图将它保存在数据当前所在的工作表上，而不是创建新工作表。如果更容易创建一个新工作表..那么我可以使用它...脚本：

Sub ColumnTorow()

  Dim maxRows As Double
    Dim maxCols As Integer
    Dim data As Variant
    maxRows = Cells(1, 1).End(xlDown).row
    maxCols = Cells(1, 1).End(xlToRight).Column

    data = Range(Cells(1, 1), Cells(maxRows, maxCols))

    With ActiveSheet

        Dim rRow As Long
        rRow = 2

        Dim row As Long

        row = 2
        Dim col As Integer

        Do While True

            col = 2
            Do While True
                If data(row, col) = "" Then Exit Do 'Skip Blanks


                .Cells(rRow, 1).Value = data(row, 1)


                .Cells(rRow, 2).Value = data(row, col)

                rRow = rRow + 1
                If col = maxCols Then Exit Do 'Exit clause
                col = col + 1
            Loop

            If row = maxRows Then Exit Do 'exit cluase
            row = row + 1
        Loop

    End With
End Sub

这只是我提供的一个示例代码，我正在尝试修改......它甚至可能不是这个问题的正确解决方案，但我认为无论如何我都会发布它。

Answer 1

在这里，自从我昨天这样做以来，我很快就把它弄到了一起：

Sub ColumnToRow()

  Dim maxRows As Double
    Dim maxCols As Integer
    Dim data As Variant
    maxRows = Cells(1, 1).End(xlDown).row
    maxCols = Cells(1, 1).End(xlToRight).Column

    data = Range(Cells(1, 1), Cells(maxRows, maxCols))

    Dim newSht As Worksheet
    Set newSht = Sheets.Add

    With newSht

        .Cells(1, 1).Value = data(1, 1)
        .Cells(1, 2).Value = data(1, 2)
        .Cells(1, 3).Value = data(1, 3)
        .Cells(1, 4).Value = data(1, 4)

        Dim writeColumn As Double
        writeColumn = 1

        Dim writeRow As Double
        writeRow = 2

        Dim row As Double
        row = 2

        Do

            writeColumn = 1

            Dim col As Double
            col = 4

            Do While True
                If data(row, col) <> "" Then
                    Dim firstColData As String
                    firstColData = data(row, 1)
                    .Cells(writeRow, writeColumn) = firstColData
                    writeColumn = 2


                    Dim secondColData As String
                    secondColData = data(row, 2)
                    .Cells(writeRow, writeColumn) = secondColData
                    writeColumn = 3

                    Dim thirdColData As String
                    thirdColData = data(row, 3)
                    .Cells(writeRow, writeColumn) = thirdColData
                    writeColumn = 4

                    .Cells(writeRow, writeColumn).Value = data(row, col)

                    writeColumn = 1
                    writeRow = writeRow + 1

                End If

                If col = maxCols Then
                    Exit Do 'Exit clause
                End If
                col = col + 1

            Loop

            If row = maxRows Then
                Exit Do 'exit cluase
            End If
            row = row + 1

        Loop While True


    End With
End Sub

Answer 2

考虑这段代码。

{{1}}

将列固定为行

2 个答案: