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 

然後刪除所有，但兩個創建的列。