VBA排序，並安排領域

Question

我在MS-Excel中的數據如下：通過線第一

No1 ABC  
No2 DEF 
No2 HJK  
No3 HIJ 
No3 XYZ 
No3 FGH 
No4 KLM 

Answer 1

參見下文，更新源 - 範圍（ 「A1」）和地點 - 範圍（ 「F1」）或進行動態酌情：

Dim data() As Variant 
Dim i As Double, j As Double 
Dim rowOffset 

Dim result As Variant 
Dim results As New Collection 

data = Range("A1").CurrentRegion 

For i = 1 To UBound(data, 1) 

    For j = 2 To UBound(data, 2) 

     If (Trim(data(i, j)) <> vbNullString) Then 

      results.Add (data(i, 1) & "|" & data(i, j)) 

     End If 

    Next j 

Next i 

For Each result In results 

    With Range("F1") 
     .Offset(rowOffset, 0).Value = Split(result, "|")(0) 
     .Offset(rowOffset, 1).Value = Split(result, "|")(1) 
    End With 

    rowOffset = rowOffset + 1 

Next result 

Answer 2

招行：

No1 ABC  
No2 DEF HJK 
No3 HIJ XYZ FGH 
No4 KLM 

如何我把它整理到下面使用VBA然後申請該行（行）填充其他列的數量的循環。因此，2路應該做的伎倆，是這樣的：

Private Sub AAA() 
    Dim rColumn1 As Range 
    Dim rValue As Range 
    Dim rTarget As Range 

    Set rColumn1 = Range("A1") 'assuming your data set starts in cell A1 
    Set rTarget = Range("Q1") 'assuming you want the results in columns Q and R 

    Do Until IsEmpty(rColumn1.Value2) 
     Set rValue = rColumn1.Offset(0, 1) 
     Do Until IsEmpty(rValue.Value2) 
      rTarget.Cells(1, 1).Value2 = rColumn1.Value2 
      rTarget.Cells(1, 2).Value2 = rValue.Value2 
      Set rTarget = rTarget.Offset(1, 0) 
      Set rValue = rValue.Offset(0, 1) 
     Loop 
     Set rColumn1 = rColumn1.Offset(1, 0) 
    Loop 
End Sub