vba - 在 Excel 中合并列

Question

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

一个苹果
一、香蕉
一，橙色
一、李子
b、苹果
b,浆果
b,橙色
b、葡萄柚
c、甜瓜
c、浆果
c、猕猴桃

我需要像这样将它们合并到另一张纸上

a、苹果、香蕉、橙子、李子
b、苹果、浆果、橙子、葡萄柚
c、甜瓜、浆果、猕猴桃

任何帮助，将不胜感激

此代码有效，但速度太慢。我必须循环浏览 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) <> ""