垂直リストを水平エントリに繰り返し転置する方法はありますか？

Question

私は約400社のリストを持っています。住所、電話番号、業界のカテゴリは以下の形式です。

私は手動で各企業のブロックを転置することなく、Excelでこれを行うための最速の方法だろう何

Prestige Automotive|1234 Jefferson Drive|Anywhere, TX 54321|000-000-0000|Manufacturing 

Jefferson Grocery|4321 Washington Drive|Anywhere, TX 54321|111-111-1111 

次の形式で、それが水平にリストされているようにデータを再フォーマットする必要があり

Column A 

Prestige Automotive 
1234 Jefferson Drive 
Anywhere, TX 54321 
Phone: 000-000-0000 
Primary Category: Manufacturing 
Jefferson Grocery 
4321 Washington Drive 
Anywhere, TX 54321 
Phone: 111-111-1111 
Primary Category: Grocers 
... 

？ありがとう

Answer 1

これを行うには多くの方法がありますが、1つの方法はデータを繰り返し処理して連結することです。以下は、データが一貫している場合に動作するコードです。

Sub Concat() 

Dim startRow As Integer    'the row to start in the spreadsheet 
Dim rowsToProcess As Integer  'total number of records to process 
Dim itemsPerAddress As Integer  'the items per record 
Dim horizontalRow As String   'hold the concatenated data 
Dim currentRow As Integer   'the row to start at for the current iteration 

startRow = 1 
rowsToProcess = 2 
itemsPerAddress = 5 

'set the active sheet to start, this could be set to any sheet 
Set sh = ActiveSheet 

'start the process of looping each record 
For x = startRow To rowsToProcess 

    horizontalRow = "" 
    currentRow = (x - 1) * itemsPerAddress + 1 

    'loop over the fields for the current record 
    For y = 1 To itemsPerAddress 
     If (y <= 3) Then 
      horizontalRow = horizontalRow & sh.Cells(currentRow, 1).Value & "|" 
     Else 
      If (y = 4) Then 
       horizontalRow = horizontalRow & Mid(sh.Cells(currentRow, 1).Value, 8) & "|" 
      Else 
       horizontalRow = horizontalRow & Mid(sh.Cells(currentRow, 1).Value, 18) 
      End If 
     End If 
     currentRow = currentRow + 1 
     'here you could do something with the horizontal row, paste it in another sheet or save to file 
    Next 
Next 

End Sub