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

Question

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

最后我想在excel中使用'table form'

列表表格

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

已编辑 - 请参阅以下第一段代码我认为这对您有用。原始列表应该在＆＃34; Sheet1＆＃34;中，有序数据写入＆＃34; Sheet2＆＃34;。我使用数组（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

根据评论更新 在您的评论中，您要求进行第二次列表到表的转换。基本上你首先需要区分＆＃34;两件事＆＃34;在你的清单中。这取决于您的数据。我选择检查单元格中的前两个（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