如何将带有标题的列表转换为表格

除了手动操作之外，有没有办法自动将数据从“列表形式”转换为“表格形式”？

最后我想使用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  

表格形式

任何帮助将不胜感激。我什至不知道要谷歌什么才能找到如何做到这一点

编辑 - 请参阅下面的第一段代码我认为这对你有用。原始列表应该位于“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 and 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