重複データの削除（数値列は合計させたい）VBA

下記データがありますが、A列で重複しているデータを削除したいです。
ただし、重複しているA列のデータのB列の数値を合計して残したいです。（VBAにて）
ピボットテーブルも考えましたが、https://oshiete.goo.ne.jp/qa/11175727.htmlのように
パソコンによってエラーになってしまいます。
他にSUMIFで工夫しようとしましたが、100万行ぐらいあるデータなので処理にすごく時間が
かかってしまいました。
構文をご教授頂けないでしょうか。

例
　　A　　B
1　名前　数量
2　BB　　1
3　BB　　3
4　AA　　2
5　BB　　10
・
・
↓
　　A　　B
1　名前　数量
2　BB　　14
3　AA　　2

No.2 回答者： d-q-t-p 回答日時： 2019/06/25 11:21

100万行となるとどうやっても処理は重くなりますが PowrQuery

ならピボットテーブルと違って 100万行でも計算します。

[名前]に対して[列のピボット]を[数量]の[合計]で実行してから
集計結果に対して [列のピボット解除]を実行すればいいです。

この回答へのお礼

ありがとうございました。
PowrQueryは初めて知りました。
一度試してみたいと思います。

お礼日時：2019/06/25 16:33

No.1 ベストアンサー 回答者： tom04 回答日時： 2019/06/25 08:23

こんにちは！

＞100万行ぐらいあるデータなので・・・

行数としては４万８千行程度余裕があるといってもExcelでは少しきついかもしれませんね。

一例です。
元データに手を付けるのではなく、別シートに表示する方法にしてみました。
元データはSheet1にあり、Sheet2に表示するとします。
標準モジュールです。

Sub Sample1()
　Dim myDic As Object
　Dim i As Long, lastRow As Long
　Dim wS As Worksheet
　Dim myKey, myItem, myR

　　Set myDic = CreateObject("Scripting.Dictionary")
　　Set wS = Worksheets("Sheet2")
　　　wS.Range("A:B").ClearContents
　　　With Worksheets("Sheet1")
　　　　wS.Range("A1:B1").Value = .Range("A1:B1").Value
　　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　　myR = Range(.Cells(2, "A"), .Cells(lastRow, "B"))
　　　　　　　For i = 1 To UBound(myR, 1)
　　　　　　　　If Not myDic.exists(myR(i, 1)) Then
　　　　　　　　　myDic.Add myR(i, 1), myR(i, 2)
　　　　　　　　Else
　　　　　　　　　myDic(myR(i, 1)) = myDic(myR(i, 1)) + myR(i, 2)
　　　　　　　　End If
　　　　　　　Next i
　　　End With
　　　　myKey = myDic.keys
　　　　myItem = myDic.items
　　　　　myR = Range(wS.Cells(2, "A"), wS.Cells(UBound(myKey) + 2, "B"))
　　　　　　For i = 0 To UBound(myKey)
　　　　　　　myR(i + 1, 1) = myKey(i)
　　　　　　　myR(i + 1, 2) = myItem(i)
　　　　　　Next i
　　　　　Range(wS.Cells(2, "A"), wS.Cells(UBound(myKey) + 2, "B")) = myR
　　　　Set myDic = Nothing
　　　　MsgBox "完了"
End Sub

ある程度の時間短縮はできるはずです。
こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

ありがとうございました。
かなりの時間短縮を実現する事が出来ました。

お礼日時：2019/06/25 16:33