(VBA) Excel - Как переместить столбцы переменной длины в строки? - PullRequest
Новая
       11

(VBA) Excel - Как переместить столбцы переменной длины в строки?

0 голосов
/ 10 сентября 2018

У меня есть лист Excel с переменными строками, но 5 столбцами. Последний столбец содержит значения различной длины, разделенные запятыми.

Я пытался написать «Для цикла», чтобы переместить эти данные в строки, сохраняя данные в существующих столбцах 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 голосов
/ 12 сентября 2018

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

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

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
...