在 Excel 中合并列

Question

我在 Excel 中有两列，如下所示

a,apple
一个，班纳纳
一个，橙色
一个，李子
b、苹果
b、浆果
b、橙色
b、葡萄柚
c、甜瓜
c、浆果
c，猕猴桃

我需要将它们像这样合并在不同的纸上

a，苹果，香蕉，橙色，李子
b、苹果、浆果、橙子、葡萄柚
c，melon，berry，kiwi

任何帮助将不胜感激

此代码可以工作，但速度太慢了。我必须循环浏览 300000 个条目。

Dim MyVar As String
Dim Col
Dim Var

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

    ' Select first line of data.
  For Var = 1 To 132536
  Sheets("Line Item Detail").Select
  Range("G2").Select
  ' Set search variable value.
  Var2 = "A" & Var

  MyVar = Sheets("Sheet1").Range(Var2).Value

  'Set Do loop to stop at empty cell.
  Col = 1
  Do Until IsEmpty(ActiveCell)
     ' Check active cell for search value.
     If ActiveCell.Value = MyVar Then

        Col = Col + 1
        Sheets("Sheet1").Range(Var2).Offset(0, Col).Value = ActiveCell.Offset(0, 1).Value


     End If
     ' Step down 1 row from present location.
     ActiveCell.Offset(1, 0).Select
  Loop
  Next Var

 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 Application.EnableEvents = True

Answer 1

您的代码是一个很好的起点。结合一些东西来加快速度。

不要使用 ActiveCell 和 SelectValue，只需像这样直接更改值：

Sheet1.Cells(1, 1) = "asdf"

此外，在开始循环之前，在第一个（键）列上对工作表进行排序（如果需要以编程方式执行此操作，可以使用 VBA 排序方法）。这可能需要一点时间，但从长远来看会节省你的时间。然后，您的 Do Until IsEmpty 内部循环只需持续到键的值发生变化，而不是每次都遍历整个数据集。这会将您的运行时间减少一个数量级。

更新
我在下面包含了一些代码。它在大约一分钟内运行了 300K 随机数据行。排序大约花费了3秒。 （我有一个普通的桌面 - 大约 3 岁）。

在 VBA 中排序，如下所示 Sheet1.Range("A1:B300000").Sort key1:=Sheet1.Range("A1")。您还可以将 Range 参数替换为两个 Cell 参数（有关示例，请参阅 Excel 帮助）。

处理代码。您可能想要参数化该工作表 - 为了简洁起见，我只是对其进行了硬编码。

    Dim LastKey As String
    Dim OutColPtr As Integer
    Dim OutRowPtr As Long
    Dim InRowPtr As Long
    Dim CurKey As String

    Const KEYCOL As Integer = 1         'which col holds your "keys"
    Const VALCOL As Integer = 2         'which col holds your "values"
    Const OUTCOLSTART As Integer = 4    'starting column for output

    OutRowPtr = 0   'one less than the row you want your output to start on
    LastKey = ""
    InRowPtr = 1    'starting row for processing

    Do
        CurKey = Sheet2.Cells(InRowPtr, KEYCOL)
        If CurKey <> LastKey Then
            OutRowPtr = OutRowPtr + 1
            LastKey = CurKey
            Sheet2.Cells(OutRowPtr, OUTCOLSTART) = CurKey
            OutColPtr = OUTCOLSTART + 1
        End If

        Sheet2.Cells(OutRowPtr, OutColPtr) = Sheet2.Cells(InRowPtr, VALCOL)
        OutColPtr = OutColPtr + 1
        InRowPtr = InRowPtr + 1

    Loop While Sheet2.Cells(InRowPtr, KEYCOL) <> ""

Answer 2

你能尝试一下吗？

ThisWorkbook.Sheets("Sheet1").Cells.ClearContents
intKeyCount = 0
i = 1

' loop till we hit a blank cell
Do While ThisWorkbook.Sheets("Line Item Detail").Cells(i, 1).Value <> ""
    strKey = ThisWorkbook.Sheets("Line Item Detail").Cells(i, 1).Value

    ' search the result sheet
    With ThisWorkbook.Worksheets("Sheet1")
    For j = 1 To intKeyCount

        ' we're done if we hit the key
        If .Cells(j, 1).Value = strKey Then
            .Cells(j, 2).Value = .Cells(j, 2).Value + 1
            .Cells(j, .Cells(j, 2).Value).Value = ThisWorkbook.Sheets("Line Item Detail").Cells(i, 2).Value
            Exit For
        End If
    Next

    ' new key
    If j > intKeyCount Then
        intKeyCount = intKeyCount + 1
        .Cells(j, 1).Value = strKey
        .Cells(j, 3).Value = ThisWorkbook.Sheets("Line Item Detail").Cells(i, 2).Value
        ' keep track of which till which column we filled for the row
        .Cells(j, 2).Value = 3
    End If
    End With

    i = i + 1
Loop

' delete the column we used to keep track of the number of values
ThisWorkbook.Worksheets("Sheet1").Columns(2).Delete

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

Answer 3

抱歉，我无法提供更多帮助，因为我手边没有 Excel。

以下是使用 VBA 的关于该主题的相关主题：

http://www. mrexcel.com/forum/showthread.php?t=459716

以及该线程的片段：

Function MultiVLookup(rngLookupValues As Range, strValueDelimiter As String, rngLookupRange As Range, TargetColumn As Integer) As String
Dim varSplitValues As Variant, varItem As Variant, strResult As String, i As Integer, varLookupResult As Variant

varSplitValues = Split(rngLookupValues, strValueDelimiter, -1, vbTextCompare)

For Each varItem In varSplitValues

    On Error Resume Next
    varLookupResult = Application.WorksheetFunction.VLookup(varItem, rngLookupRange, TargetColumn, False)

    If Err.Number <> 0 Then
        strResult = strResult & "#CompanyNameNotFound#"
        Err.Clear
    Else
        strResult = strResult & varLookupResult
    End If
    On Error GoTo 0

    If UBound(varSplitValues) <> i Then
        strResult = strResult & ", "
    End If
    i = i + 1
Next varItem

MultiVLookup = strResult

End Function

Answer 4

您可能需要考虑一种基于数据透视表的方法。

使用“行标签”区域中的两个字段创建一个数据透视表（如果使用 Excel 2007，请使用“经典”格式）。删除小计和总计。这将为您提供每个类别的所有值的唯一列表。然后，您可以复制并粘贴值以获取以下格式的数据：

a   apple
    bannana
    orange
    plum
b   apple
    berry
    grapefruit
    orange
c   berry
    kiwi
    melon

所有唯一值现在都紧凑地显示，您可以使用 VBA 循环访问这个较小的数据子集。

如果您需要有关创建数据透视表的 VBA 的任何帮助，请告诉我。

Answer 5

这可以使用数据透视表和分组在不到 1 分钟的时间内手动完成。

• 创建一个带有水果的数据透视表，当行字段（最左边的列）
• 移动时，拖动要分组的水果并排
• 进行分组，选择最左边列中的单元格，然后从数据透视表菜单中选择“分组”，
• 为每个重复上一个点 现在您可以“手动

”以有效的方式完成它，记录它并正确重写它，并且您最终可能会使用其环境（Excel）的设施获得高效的代码。