(VBA)Excel-如何将可变长度列转置为行?

时间:2018-09-10 09:29:58

标签: excel vba transpose

我有一个Excel工作表,其中有可变行但有5列。 最后一列具有长度不同的逗号分隔值。

我一直在尝试编写“ For循环”以将该数据转置为行,同时将数据保留在现有列A:D中。

源数据样本

| User ID | User name | Group ID | Group name | Effective permissions |      |      |      |      |      |
|---------|-----------|----------|------------|-----------------------|------|------|------|------|------|
| 1       | Adam      | 100      | Active     | ABCD                  | RFGE | ERTY | EDFR |      |      |
| 2       | Bryan     | 100      | Bold       | IFEU                  | WASD | WASF | TGRE | YMUN | TYBN |
| 3       | Charles   | 100      | Charity    | IFLL                  | ERTY | WSDF | XKLS |      |      |
| 4       | David     | 100      | Danger     | IFEU                  | UNBY | RVBT | ZXCV | XCVB | VBNM |

输出数据示例

| User ID | User name | Group ID | Group name | Effective permissions |
|---------|-----------|----------|------------|-----------------------|
| 1       | Adam      | 100      | Active     | ABCD                  |
| 1       | Adam      | 100      | Active     | RFGE                  |
| 1       | Adam      | 100      | Active     | ERTY                  |
| 1       | Adam      | 100      | Active     | EDFR                  |
| 2       | Bryan     | 100      | Bold       | IFEU                  |
| 2       | Bryan     | 100      | Bold       | WASD                  |
| 2       | Bryan     | 100      | Bold       | WASF                  |
| 2       | Bryan     | 100      | Bold       | TGRE                  |
| 2       | Bryan     | 100      | Bold       | YMUN                  |
| 2       | Bryan     | 100      | Bold       | TYBN                  |
| 3       | Charles   | 100      | Charity    | IFLL                  |
| 3       | Charles   | 100      | Charity    | ERTY                  |
| 3       | Charles   | 100      | Charity    | WSDF                  |
| 3       | Charles   | 100      | Charity    | XKLS                  |
| 4       | David     | 100      | Danger     | IFEU                  |
| 4       | David     | 100      | Danger     | UNBY                  |
| 4       | David     | 100      | Danger     | RVBT                  |
| 4       | David     | 100      | Danger     | ZXCV                  |
| 4       | David     | 100      | Danger     | XCVB                  |
| 4       | David     | 100      | Danger     | VBNM                  |

我们将不胜感激。

**我过去已经完成了VBA项目,但是通常我可以将以前的示例拼凑起来以实现我的目标...一路学习。

如果有人可以告诉我如何修改下面的代码,以便将我的前4列中的每个值都复制下来,那就太好了。

Sub Test()

Set Rng = Sheets("Test").Range("D2:D15")
Set Rng_output = Sheets("Test2").Range("A2")

For i = 1 To Rng.Cells.Count
    Set rng_values = Range(Rng.Cells(i).Offset(0, 1), Rng.Cells(i).End(xlToRight))

    If rng_values.Cells.Count < 16000 Then
        For j = 1 To rng_values.Cells.Count
                Rng_output.Value = Rng.Cells(i).Value
                Rng_output.Offset(0, 1).Value = rng_values.Cells(j).Value
                Set Rng_output = Rng_output.Offset(1, 0)
        Next j
    End If
Next i

End Sub

1 个答案:

答案 0 :(得分:0)

您与该代码非常接近。

这是相同的代码,但有一些小的更改:

Sub Test()

    Set Rng = Sheets("Test").Range("D2:D15")
    Set Rng_output = Sheets("Test2").Range("A2")

    For i = 1 To Rng.Cells.Count

        'Test to make sure there is less than 16000 columns in this row past D. Yikes, OP!
        Set rng_values = Range(Rng.Cells(i).Offset(0, 1), Rng.Cells(i).End(xlToRight))
        If rng_values.Cells.Count < 16000 Then      
            'Loop through all of those columns
            For j = 1 To rng_values.Cells.Count         
                'Write out value from Column A:D to our Rng_Output
                Rng_Output.Value = rng.cells(i).Offset(0,-3).value 'Column A = Column A
                Rng_Output.Offset(0,1).Value = rng.cells(i).Offset(0,-2).value 'Column B = Column B
                Rng_Output.Offset(0,2).value = rng.cells(i).OFfset(0,-1).value 'etc..
                Rng_Output.Offset(0,3).value = rng.cells(i).value

                'Write out value from Column A:D to your `Test2` sheet column E                 
                rng_output.Offset(0,1).Value = rng_values.Cells(j).value

                'Increment to the next row
                Set Rng_output = Rng_output.Offset(1)
            Next j
        End If


    Next i

End Sub