有多個列表的Excel表格

Question

我有下面的表格（輸入）。 我正在尋找一種獲取列表輸出的方法（見圖）。

Table Input/Output

Answer 1

以下應該有所幫助：

Option Explicit 

Sub Demo() 
    Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 

    Dim lastRow As Long, lastCol As Long, rowIndex As Long, colIndex As Long 
    Dim i As Long, currRow As Long 
    Dim ws As Worksheet, arr 

    Set ws = ThisWorkbook.Worksheets("Sheet1")  'change Sheet1 to your working sheet 

    With ws 
     lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'get last row in column A 
     lastCol = Cells(3, Columns.Count).End(xlToLeft).Column 'get last column in row 3 
     currRow = 3  'output will be displayed from row 3 

     For rowIndex = 4 To lastRow 'loop through all rows in input starting with row 4 
      For colIndex = 2 To lastCol 'loop trough all columns in input starting form column 2 
       arr = Split(.Cells(rowIndex, colIndex).Value, ",") 'put comma separated value of a cell in array 
       For i = LBound(arr) To UBound(arr) 'loop through array item 
        .Range("I" & currRow).Value = .Range("A" & rowIndex).Value 'display name 
        .Range("J" & currRow).Value = .Cells(3, colIndex) 'display date 
        .Range("K" & currRow).Value = Trim(arr(i)) 'display cell value 
        currRow = currRow + 1  'increment crrRow value by 1 
       Next i 
      Next colIndex 
     Next rowIndex 
    End With 

    Application.ScreenUpdating = True 
    Application.Calculation = xlCalculationAutomatic 
End Sub 

參考文獻見圖像。