如何迭代地将垂直列表转置为水平条目?

时间:2016-08-07 20:10:51

标签: excel excel-vba vba

我列出了大约400家公司,包括地址,电话号码和行业类别,格式如下。

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
...

我需要重新格式化数据,使其以水平方式列出,格式如下

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

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

在excel中执行此操作的最快方法是什么,而无需手动转置每个公司块?感谢

1 个答案:

答案 0 :(得分: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