text 将Excel列拆分为行

Posted 2021-05-02

Sub ShrinkTable()
    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 = "SKU"
        .Cells(1, 2).Value = "Dimensions"
        .Cells(1, 3).Value = "Manufacturer"

        Dim writeRow As Double
        writeRow = 2

        Dim row As Double
        row = 2
        Dim col As Integer

        Do While True

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

                'SKU
                .Cells(writeRow, 1).Value = data(row, 1)
                
                'SIZE
                .Cells(writeRow, 2).Value = data(row, 2)

                'Manufacturer
                   
                strOrig = data(row, col)
                comma_left = InStr(strOrig, ",") - 1
                comma_right = Len(strOrig) - InStr(strOrig, ",") - 1
                
                leftString = Left(strOrig, comma_left)
                rightString = Right(strOrig, comma_right)
                
                .Cells(writeRow, 3).Value = leftString
                .Cells(writeRow, 4).Value = rightString

                writeRow = writeRow + 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