在Excel中合并列
我在Excel中有两列，如下所示
一个苹果
一，bannana
一，橙色
一，梅花
B，苹果
B，浆果
B，橙色
B，柚子
C，瓜
C，浆果
C，猕猴桃
我需要在不同的工作表上合并它们
一，苹果，bannana，橘子，李子
B，苹果，浆果，柑橘，柚子
C，瓜，果，猕猴桃
任何帮助，将不胜感激
这段代码有效，但速度太慢。 我必须循环30万条目。
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 你的代码是一个很好的起点。 夫妇的事情来加快它。
而不是使用ActiveCell和SelectValue直接更改值，如下所示：
Sheet1.Cells(1, 1) = "asdf"
此外，在开始循环之前在第一个（键）列上对表单进行sorting（如果需要以编程方式执行此操作，则有VBA Sort方法）。 这可能需要一点时间，但从长远来看将会拯救你。 那么你的Do直到IsEmpty内循环只需要直到键的值改变，而不是每次都通过整个数据集。 这可以将运行时间缩短一个数量级。
UPDATE
我已经在下面包含了一些代码。 它运行了大约一分钟，为300K随机数据线。 sorting花了大约3秒钟。 （我有一个正常的桌面 – 约3岁）。
按如下Sheet1.Range("A1:B300000").Sort key1:=Sheet1.Range("A1")sortingVBA Sheet1.Range("A1:B300000").Sort key1:=Sheet1.Range("A1") 。 你也可以用两个单元参数replaceRange参数（参见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) <> ""
你能给这个镜头吗？
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
对不起，我不能更有帮助，我没有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
有一个基于数据透视表的方法可能需要考虑。
创build数据透视表（如果使用Excel 2007，请使用“经典”格式），同时在“行标签”区域中使用这两个字段。 删除小计和总计。 这将为您提供每个类别的所有值的唯一列表。 然后，您可以复制并粘贴值，以便以这种格式获取数据：
a apple bannana orange plum b apple berry grapefruit orange c berry kiwi melon
现在所有的唯一值都被紧凑地显示出来了，你可以使用VBA循环这个更小的数据子集。
如果您需要任何关于数据透视表创build的VBA帮助，请告诉我。
这可以通过数据透视表和分组在不到1分钟的时间内完成。
- 创build一个水果作为行字段（最左边的一列）
- 把你想要分组的水果拖动到一起
- 进行分组，select最左列中的单元格，然后从数据透视表菜单中select分组
- 重复每个组的前一个点
现在你可以用“手工”的方式来完成这个有效的工作，logging下来，并且正确地重写，最后你可以用高效的代码，使用它的环境设施（Excel）。