☰

使用 Excel 中的轉置工具處理大量值

tag-icon • tag-icon microsoft-excel vba
使用 Excel 中的轉置工具處理大量值

我擁有一張非常大的姓名和地址資料工作表。現在，它看起來類似於：

               Name   Number       Address
                                   Address
                                   Address
                                  (Address)

像這樣的組有成百上千個，所有組都至少被一個空白行分隔開。現在，我可以手動使用轉置工具，但這將花費我相當長的時間。我想過只寫一個巨集來做到這一點，但是有些地址是三行，而有些是四行，所以這讓我很困惑，是否可能這樣做。

有什麼簡單的方法可以做到這一點，而不必全部手工完成嗎？

答案1

現在，我假設您希望最終結果類似於下圖，個人之間沒有線條，並且一個單元格中的一行上有完整地址

Name    Number  Address
Name    Number  Address
Name    Number  Address
Name    Number  Address
Name    Number  Address
Name    Number  Address

我還假設您的資料從儲存格 A1 開始，並且每個名稱都是唯一的。如果沒有，那麼巨集將需要一些小的調整。設定Stopper = 50000為最後一組資料之後的行，否則這可能會持續超過必要的時間（或可能不夠長）。

Sub CollectThem()
    Dim All As New Collection
    Dim One As Variant
    Dim Addy As Variant, Stopper As Long, L1 As Integer

    Stopper = 645

    Cells(1, 1).Select
    Do Until ActiveCell.Row >= Stopper
        ReDim One(0 To 2)
        One(0) = ActiveCell.Offset(0, 0).Value
        One(1) = ActiveCell.Offset(0, 1).Value
        Addy = ""
        Do Until ActiveCell.Row >= Stopper Or (ActiveCell.Value <> "" And ActiveCell.Value <> One(0))
            Addy = Addy & ActiveCell.Offset(0, 2).Value & "|"
            ActiveCell.Offset(1, 0).Select
        Loop
        One(2) = Trim(Addy)
        All.Add One
        Erase One
    Loop

    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Select

    Cells(1, 1).Select
    For Stopper = 1 To All.Count
        One = All(Stopper)
        ActiveCell.Offset(0, 0).Value = One(0)
        ActiveCell.Offset(0, 1).Value = One(1)
        Addy = Split(One(2), "|")
        If IsArray(Addy) Then
            For L1 = 0 To UBound(Addy)
                ActiveCell.Offset(0, 2 + L1).Value = Addy(L1)
            Next L1
            Erase Addy
        Else
            ActiveCell.Offset(0, 2).Value = One(2)
        End If
        ActiveCell.Offset(1, 0).Select
        Erase One
    Next Stopper
End Sub

相關內容