☰

使用 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

相关内容