Excel VBA Текст в столбец

Question

Это то, что у меня сейчас есть:

H101    John Doe    Jane Doe    Jack Doe    
H102    John Smith  Jane Smith  Katie Smith Jack Smith

А вот что я хочу:

H101    John Doe
H101    Jane Doe
H101    Jack Doe
H102    John Smith
H102    Jane Smith
H102    Katie Smith
H102    Jack Smith

Очевидно, я хочу сделать это в большем масштабе. Количество столбцов составляет от 1 до 6, поэтому я не могу ограничить это таким образом. Я смог получить сценарий, который позволяет мне помещать каждого человека в один ряд. Однако мне трудно заставить первый столбец копировать в каждую строку.

Sub ToOneColumn()
Dim i As Long, k As Long, j As Integer
Application.ScreenUpdating = False
Columns(2).Insert
i = 0
k = 1
While Not IsEmpty(Cells(k, 3))
    j = 3
    While Not IsEmpty(Cells(k, j))
        i = i + 1
        Cells(i, 1) = Cells(k, 1) //CODE IN QUESTION
        Cells(i, 2) = Cells(k, j)
        Cells(k, j).Clear
        j = j + 1
    Wend
    k = k + 1
Wend
Application.ScreenUpdating = True
End Sub

Как я уже сказал, все работало нормально, чтобы каждый находился в отдельном ряду, но не могу понять, как получить первый столбец. Кажется, это должно быть так просто, но это меня беспокоит. Любая помощь с благодарностью.

Answer 1

Я думаю, что вы пишете свои данные в столбце 1. Вы создаете новый столбец для имен, но не для первого столбца, хотя это зависит от того, какой именно ваш исходный формат.

Попробуйте это:

Sub ToOneColumn()
Dim i As Long, k As Long, j As Integer
Application.ScreenUpdating = False
Columns(2).Insert
Columns(2).Insert
i = 0
k = 1
While Not IsEmpty(Cells(k, 3))
    j = 4
    While Not IsEmpty(Cells(k, j))
        i = i + 1
        Cells(i, 2) = Cells(k, 1) //CODE IN QUESTION
        Cells(i, 3) = Cells(k, j)
        Cells(k, j).Clear
        j = j + 1
    Wend
    k = k + 1
Wend
Application.ScreenUpdating = True
End Sub

Затем удалите все, кроме двух созданных столбцов.