1

次のようにExcelに2つの列があります

a、リンゴ
a、バナナ
a、オレンジ
a、プラム
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
4

5 に答える 5

2

あなたのコードは良い出発点です。それをスピードアップするために物事をカップルします。

ActiveCellとSelectValueを使用する代わりに、次のように値を直接変更します。 

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

また、ループを開始する前に、最初の（キー）列でシートを並べ替えます（これをプログラムで行う必要がある場合は、VBAの並べ替え方法があります）。少し時間がかかるかもしれませんが、長期的にはあなたを救うでしょう。次に、Do until IsEmpty内部ループは、毎回データセット全体を通過するのではなく、キーの値が変更されるまで実行する必要があります。これにより、実行時間が1桁短縮されます。

更新
私は以下にいくつかのコードを含めました。300Kのランダムデータラインでは約1分で実行されました。ソートには約3秒かかりました。（私は通常のデスクトップを持っています-約3歳です）。

次のようにVBAで並べ替えますSheet1.Range("A1:B300000").Sort key1:=Sheet1.Range("A1")。Rangeパラメータを2つの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) <> ""
于 2010-06-10T13:10:03.470 に答える
1

これを試してみませんか？

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
于 2010-06-10T07:14:03.787 に答える
0

これは、ピボットテーブルとグループ化を使用して1分未満で手動で実行できます。

  • 行フィールド（左端の列）として果物を使用してピボットを作成します
  • グループ化する果物を並べてドラッグします
  • グループ化するには、左端の列のセルを選択し、ピボットテーブルメニューから[グループ化]を選択します
  • グループごとに前のポイントを繰り返します

これで、「手作業」で効率的な方法で実行し、記録し、適切に書き直すことができるようになりました。その環境（Excel）の機能を使用して、効率的なコードを作成することができます。

于 2010-06-10T18:16:56.017 に答える
0

申し訳ありませんが、私は 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
于 2010-06-09T23:14:20.207 に答える
0

ピボット テーブル ベースのアプローチを検討することをお勧めします。

[行ラベル] 領域の両方のフィールドでピボット テーブルを作成します (Excel 2007 を使用している場合は、「クラシック」形式を使用します)。小計と総計を削除します。これにより、各カテゴリのすべての値の一意のリストが得られます。次に、値をコピーして貼り付けて、データを次の形式で取得できます。

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

すべての一意の値がコンパクトに表示され、VBA を使用して、この小さなデータのサブセットをループできます。

ピボット テーブルを作成するための VBA に関するヘルプが必要な場合は、お知らせください。

于 2010-06-10T08:45:49.917 に答える