(vba) excel - как перенести столбцы переменной длины в строки?

У меня есть лист 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

^^ И также не делайте снимков экрана, так как мы не можем скопировать и вставить их для тестирования. Используйте такой инструмент, как генератор таблицы уценки, для форматирования данных для вставки между тегами кода.

QHarr 10.09.2018 11:38

Я попытался ответить на этот связанный вопрос: stackoverflow.com/questions/44655553/… (Решения Apple / Bananas очень близки к тому, чего я хотел бы достичь) Однако в моем примере у меня есть столбцы A: D для копирования данных строки. @QHarr спасибо, какое-то время пробовал, прежде чем прибегнуть к картинке. Я поменяю.

Tony Butcher 11.09.2018 09:04
3
2
208
1

Ответы 1

Вы очень близки с этим кодом.

Вот тот же код с небольшими изменениями:

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

Другие вопросы по теме