excel - Excel と VBA を使用して、繰り返し行から列にレコードを移動する

Question

約 70,000 行のデータと、50 ～ 100 行 (レコード) ごとに繰り返される 2 つの列 (フィールド、データ) があります。「フィールド テキスト」に基づいて値を検索するものを作成し (約 5 つのフィールドにのみ関心があります)、行をレコードとして、列をフィールドとして新しいワークシートに値を貼り付けたいと思います。検索する最初のフィールドは、新しい行/レコードを示す必要があります。

これに対する私の最初の試みは失敗し、フォーラムにはほとんど助けがありませんでした。ピボットテーブルでこれができるように見えますが？

やりたいことのビジュアル： 例

編集：

思った通りの結果が得られましたが、「END」までの処理がうまくいきません。データの最後のセルに「END」があります。また、これを行うためのより効率的な方法があると確信していますが、何かアドバイスはありますか? ありがとう！

Sub TracePull()

Dim i As Long
Dim j As Long

i = 1
j = 1

ActiveWorkbook.Sheets("Trace").Range("A1").Select

Do Until Range("A" & i) = "END"

Do Until ActiveCell = "OTDRFilename"
    i = i + 1
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop

If ActiveCell = "OTDRFilename" Then
    ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
    ActiveWorkbook.Sheets("Sheet1").Range("A" & j + 1).PasteSpecial Paste:=xlValue
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
    i = i + 1
    j = j + 1
'Else
'    i = i + 1
End If

Range("A" & i).Select

Do Until ActiveCell = "OTDRSpan length"
    i = i + 1
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop

If ActiveCell = "OTDRSpan length" Then
    ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
    ActiveWorkbook.Sheets("Sheet1").Range("B" & j).PasteSpecial Paste:=xlValue
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
    i = i + 1
End If

Range("A" & i).Select

Do Until ActiveCell = "OTDRSpan loss"
    i = i + 1
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop

If ActiveCell = "OTDRSpan loss" Then
    ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
    ActiveWorkbook.Sheets("Sheet1").Range("C" & j).PasteSpecial Paste:=xlValue
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
    i = i + 1
End If

Range("A" & i).Select

Do Until ActiveCell = "OTDRAverage loss"
    i = i + 1
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop

If ActiveCell = "OTDRAverage loss" Then
    ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
    ActiveWorkbook.Sheets("Sheet1").Range("D" & j).PasteSpecial Paste:=xlValue
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
    i = i + 1
End If

Range("A" & i).Select

Do Until ActiveCell = "OTDRSpan ORL"
    i = i + 1
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop

If ActiveCell = "OTDRSpan ORL" Then
    ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
    ActiveWorkbook.Sheets("Sheet1").Range("E" & j).PasteSpecial Paste:=xlValue
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
    i = i + 1
End If

Range("A" & i).Select

Do Until ActiveCell = "OTDRWavelength"
    i = i + 1
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Activate
Loop

If ActiveCell = "OTDRWavelength" Then
    ActiveWorkbook.Sheets("Trace").Range("B" & i).Copy
    ActiveWorkbook.Sheets("Sheet1").Range("F" & j).PasteSpecial Paste:=xlValue
    ActiveWorkbook.Sheets("Trace").Range("A" & i).Select
    i = i + 1
End If

i = i + 1
ActiveWorkbook.Sheets("Trace").Range("A" & i).Select

Range("A" & i).Select

Loop

End Sub