如何将包含标题的列表转换为表格

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