如何將包含標題的列表轉換爲表格

Question

除了手動操作之外，是否有辦法將數據從「列表表單」自動轉換爲「表格」？

到底，我想在Excel中使用 '表格形式'

列表形式

Department: QUALITY CONTROL 
Worker: DAVID 
Case # 75967 
Case # 75845 
Case # 75949 
Department: PORCELAIN 
Worker: JONATHAN 
Case # 75891 
Case # 75947 
Case # 75962 
Department: SUB-STRUCTURE 
Worker: BILL 
Case # 75997 
Case # 75864 
Case # 75993 

表形式

任何幫助不勝感激。我甚至不知道該怎麼去谷歌找出如何做到這一點

Answer 1

編輯 - 見下面的第一段代碼我認爲這將適用於你。原始列表應該在「Sheet1」中，有序數據被寫入「Sheet2」。我正在使用數組（sData和sData2）來存儲時態數據。

Dim lLastRow As Long 
Dim i As Integer 
Dim k As Integer 
Dim sData() As String 
Dim sData2(0 To 2) As String 

Private Sub ListToTable() 
    'get number of rows with data 
    lLastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 
    k = 2 'destination table will start in line 2 (line 1 for titles). 
    'Set titles in destination sheet 
    Worksheets("Sheet2").Cells(1, 1).Value = "Depertment" 
    Worksheets("Sheet2").Cells(1, 1).Font.Bold = True 
    Worksheets("Sheet2").Cells(1, 2).Value = "Worker" 
    Worksheets("Sheet2").Cells(1, 2).Font.Bold = True 
    Worksheets("Sheet2").Cells(1, 3).Value = "Case" 
    Worksheets("Sheet2").Cells(1, 3).Font.Bold = True 


    For i = 1 To lLastRow 
     'split the data using ":" as delimiter 
     sData = Split(Worksheets("Sheet1").Cells(i, 1), ":") 

     If sData(0) = "Department" Then 
      sData2(0) = Trim(sData(1)) 'Trim just for eliminating spaces 
     ElseIf sData(0) = "Worker" Then 
      sData2(1) = Trim(sData(1)) 
     Else 
      sData2(2) = Trim(sData(0)) 
      Worksheets("Sheet2").Cells(k, 1).Value = sData2(0) 
      Worksheets("Sheet2").Cells(k, 2).Value = sData2(1) 
      Worksheets("Sheet2").Cells(k, 3).Value = sData2(2) 
      k = k + 1 
     End If 

    Next i 
End Sub 

根據評論 在你的意見，你問的第二列表到餐桌的改造更新。基本上你首先需要區分列表中的「兩件事」。這取決於你的數據。我選擇檢查的是前兩個（Left）單元格中的字符是否爲數字（IsNumeric）。然後代碼與上面的代碼非常相似。在頂部定義變量時，請添加Dim sFirstColumn as String和Dim iSecondColumn as Integer（或根據您的數據進行的任何操作）。

For i = 1 To lLastRow 
    If Not IsNumeric(Left(Worksheets("Sheet1").Cells(i, 1), 2)) Then 
     sFirstColumn = Worksheets("Sheet1").Cells(i, 1).Value 
    Else 
     iSecondColumn = Worksheets("Sheet1").Cells(i, 1).Value 

     Worksheets("Sheet2").Cells(k, 1).Value = sFirstColumn 
     Worksheets("Sheet2").Cells(k, 2).Value = iSecondColumn 
     k = k + 1 
    End If 
Next i