在Excel

Question

合併列我有在Excel中兩列像下面

一，蘋果
一個，bannana
一，橙色
一，梅花
B，蘋果
B，漿果
b，橙
b，柚子
C，瓜
C，漿果
C，獼猴桃

我需要整合他們這樣在不同的片

一個，蘋果，bannana，橙，李子
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直到IsEmpty內循環只需要直到該鍵的值發生變化，而不是每次都通過整個數據集。這將您的運行時間減少一個數量級。

UPDATE
我在下面包含了一些代碼。它在大約一分鐘內運行了300K隨機數據線。這種排序花了大約3秒鐘。 （我有一個正常的桌面 - 約3歲）。

按以下方式排列在VBA中Sheet1.Range("A1:B300000").Sort key1:=Sheet1.Range("A1")。您也可以用兩個單元參數替換Range參數（請參閱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

對不起，我不能更有幫助，我沒有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 3

可不可以給這個一杆？

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 4

有一個基於數據透視表的方法可能需要考慮。

創建數據透視表（如果使用Excel 2007，請使用「經典」格式），同時在行標籤區域使用這兩個字段。刪除小計和總計。這將爲您提供每個類別的所有值的唯一列表。然後，您可以複製這種格式粘貼值，讓您的數據：

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

您所有的獨特的價值觀，現在緊湊顯示，您可以通過數據的這種較小的子集使用VBA循環。

如果您需要任何有關數據透視表創建的VBA幫助，請告訴我。

Answer 5

這可以通過使用數據透視表和分組在不到1分鐘內手動完成。

• 創建要組與水果爲行字段樞軸（最左邊的列）
• 移動拖動水果下一對方
• 到組，在最左邊的列中選擇單元格，從數據透視表菜單中選擇組
• 重複前一個點的每個組

現在你能做到「手」的有效途徑，記錄下來，並妥善改寫它，你可能最終與高效的代碼，使用其環境的設施（Excel）。