タイトルを含むリストをテーブルに変換するには

Question

手動で行う以外に、 'リストフォーム'から 'テーブルフォーム'にデータを自動的に変換する方法はありますか？

最後に、私はエクセル

で '表形式' を使用したいと思っています

リスト形式

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 

表形式

どれでも役立つだろう大変感謝します。私はこれを行う方法を見つけるためにGoogleに何を知っていなかった

Answer 1

EDITED - コードの最初の部分を参照これはあなたのために働くと思う。元のリストは「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 

UPDATE。基本的には、まずあなたのリスト内の「2つのもの」を区別する必要があります。これはあなたのデータに依存します。私はチェックすることを選択するセルの最初の2つ（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