2

ワークシートには数百行あり、列Aに口座番号、列Bに口座の説明、列Cに合計があります。3つのワークシートすべての行を1つの4番目のワークシートにコピーしたいのですが、重複するアカウント番号が見つかった場合は、次のように、合計がその行の列Cに集約され、余分なものが削除されたものだけが必要です。

シートからの入力（すべてのシートは1つの.xlsファイルにあります）：

ワークブックのシート1

                A                     B                       C
1            abc-123            Project Costs             1,548.33
2            abc-321           Housing Expenses                250
3            abc-567           Helicopter Rides          11,386.91

ワークブックのシート2

                A                     B                       C
1            abc-123            Project Costs             1,260.95
2            abc-321           Housing Expenses                125
3            abc-567           Helicopter Rides          59,605.48

ワークブックのシート3

                A                     B                       C
1            abc-123            Project Costs             1,785.48
2            abc-321           Housing Expenses                354
3            def-345            Elephant Treats         814,575.31

結果を次のようにしたいと思います。

                A                     B                       C
1            abc-123            Project Costs             4,642.28
2            abc-321           Housing Expenses                729
3            abc-567           Helicopter Rides          70,992.39
4            def-345            Elephant Treats         814,575.31

注意：アカウント番号の中には繰り返されないものもありますが、繰り返されるものもあります。

4

3 に答える 3

4

これが1つの方法です。

Option Explicit

Sub Test()
    Dim sheetNames: sheetNames = Array("Sheet1", "Sheet2", "Sheet3")
    Dim target As Worksheet: Set target = Worksheets("Sheet4")
    Dim accounts As New Dictionary
    Dim balances As New Dictionary
    Dim source As Range
    Dim row As Range
    Dim id As String
    Dim account As String
    Dim balance As Double
    Dim sheetName: For Each sheetName In sheetNames
        Set source = Worksheets(sheetName).Range("A1").CurrentRegion
        Set source = source.Offset(1, 0).Resize(source.Rows.Count - 1, source.Columns.Count)
        For Each row In source.Rows
            id = row.Cells(1).Value
            account = row.Cells(2).Value
            balance = row.Cells(3).Value
            accounts(id) = account
            If balances.Exists(id) Then
                balances(id) = balances(id) + balance
            Else
                balances(id) = balance
            End If
        Next row
    Next sheetName

    Call target.Range("A2:A65536").EntireRow.Delete

    Dim rowIndex As Long: rowIndex = 1
    Dim key
    For Each key In accounts.Keys
        rowIndex = rowIndex + 1
        target.Cells(rowIndex, 1).Value = key
        target.Cells(rowIndex, 2).Value = accounts(key)
        target.Cells(rowIndex, 3).Value = balances(key)
    Next key
End Sub

  1. 新しいモジュールを作成し (VBA エディター -> 挿入 -> モジュール)、上記のコードを貼り付けます。

  2. Microsoft Scripting Runtime への参照を追加します (VBA エディター -> [ツール] -> [参照] -> [Microsoft Scripting Runtime] をチェックします)。

  3. コード内にカーソルを置き、F5 キーを押して実行します。

明らかに、シートには Sheet1、Sheet2、Sheet3、および Sheet4 という名前を付ける必要があります。列ヘッダーは Sheet4 に貼り付けられませんが、おそらく静的であるため、事前に自分で設定することができます。

于 2010-01-29T20:38:13.707 に答える
3

本当にやりたいことは、マクロを実行するか、3 つのシートからすべてのデータを新しいシートにコピーし、結果に対してピボット テーブルを実行することです。ピボット テーブルは、データ セットの一意化と、データの多重度の集計を処理します。

次の VB コードを使用できます (Excel で Alt-F11 を入力して VBA エディターに移動し、新しいモジュールを挿入して、このコードを貼り付けます)。このコードは、スプレッドシートにデータを含む Sheet1、Sheet2、および Sheet3 という名前の 3 つのシートがあり、データが連続しており、各シートのセル A1 から始まることを前提としています。また、スプレッドシートに「ピボット シート」という名前のシートがあり、そこにデータがすべてコピーされることも前提としています。

Sub CopyDataToPivotSheet()

  Sheets("Pivot Sheet").Select
  Range("A1:IV65536").Select
  Selection.Clear

  Sheets("Sheet1").Select
  Range("A1").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Range(Selection, Selection.End(xlDown)).Select
  Selection.Copy
  Sheets("Pivot Sheet").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False

  Sheets("Sheet2").Select
  Range("A1").Select
  Range(Selection, Selection.End(xlDown)).Select
  Range(Selection, Selection.End(xlToRight)).Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("Pivot Sheet").Select
  Range("A1").Select
  Selection.End(xlDown).Offset(1, 0).Range("A1").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False

  Sheets("Sheet3").Select
  Range("A1").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Range(Selection, Selection.End(xlDown)).Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("Pivot Sheet").Select
  Selection.End(xlDown).Select
  Range("A1").Select
  Selection.End(xlDown).Offset(1, 0).Range("A1").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False

  Rows("1:1").Select
  Application.CutCopyMode = False
  Selection.Insert Shift:=xlDown
  Range("A1").Select
  ActiveCell.FormulaR1C1 = "AccountNum"
  Range("B1").Select
  ActiveCell.FormulaR1C1 = "Description"
  Range("C1").Select
  ActiveCell.FormulaR1C1 = "Total"

End Sub

これは 95% が (レコード マクロを介して) Excel で生成されたコードですが、より一般的なものにするためにいくつか変更を加えました。とにかく、そのマクロを通常の方法でボタンに割り当てるか、ツール => マクロ => マクロ... オプション... ダイアログを介してキーボード ショートカットに割り当てることができます。

とにかく、適切な見出しを持つピボット シート シートにデータが集約されます。

次に、[データ] => [ピボットテーブルとピボットグラフ レポート] に移動できます。[次へ] をクリックして、ピボット シートのデータ (見出しを含む) を選択し、[次へ] をクリックして [レイアウト] を選択します。

AccountNumber フィールド (ウィザードの右側) を [行] というラベルの付いた領域にドラッグします。[行] 領域の [アカウント番号] フィールドの下に [説明] フィールドをドラッグします。合計フィールドを [データ] エリアにドラッグし、[データ] エリアでダブルクリックして [合計] を選択し、このフィールドを集計します。[OK] をクリックすると、ピボット テーブルが表示されます。小計のタイトル (つまり、「何とか合計」) を右クリックし、[非表示] をクリックして、小計を非表示にすることができます。その結果は、基本的に、目的の出力とまったく同じように見えます。

工夫を凝らしたければ、おそらく最後の段落を自動化することもできますが、おそらくそれだけの価値はありません。

お役に立てれば！

于 2010-01-29T20:13:32.040 に答える
2

これにはADOが最適だと思います。ここにいくつかのメモがあります：Excelシートの重複を検出する関数

適切な SQL 文字列を使用して、レコードを結合およびグループ化できます。

例えば：

strSQL = "SELECT F1, F2, Sum(F3) FROM (" _
       & "SELECT F1,F2,F3 FROM [Sheet1$] " _
       & "UNION ALL " _
       & "SELECT F1,F2,F3 FROM [Sheet2$] " _
       & "UNION ALL " _
       & "SELECT F1,F2,F3 FROM [Sheet3$] ) " _
       & "GROUP BY F1, F2"
于 2010-01-29T20:32:08.827 に答える