こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

締切り済みの質問

ExcelVBA Dictionaryオブジェクト

こんにちは。
Dictionaryオブジェクトについて、ご教示いただきたく質問させていただきます。

あるCSVデータにおいて、A列に入力されている番号で重複をなくし、重複する番号については、B列(売上額)C列(利益額)それぞれの値を合計してSheet2に表示させるコード(test1)を書きました。データの行数が3万5千行ほどあるため、処理が終わるのに3分程かかります。

今後もデータは増えていくので、処理終了までの時間をもう少し短縮したく、自分なりに調べてみたところ、Dictionaryオブジェクトというものを知り、使用例を参考にしながら見よう見まねでコード(test2)を書いて試してみたところ、処理終了まで数秒となり、かなり短縮されました。
エラーも出ることなく処理できるものの、Dictionaryオブジェクトに対する理解がイマイチでして、コードの書き方等、問題ないかを知りたく質問させていただいた次第です。
よろしくお願いいたします。
------------------------------------------------------------------------------
Sub test1()
Dim i As Long
Dim lastRow As Long
Dim ws As Worksheet

Application.ScreenUpdating = False
'不要データ削除
Rows("1:3").Select
Selection.Delete Shift:=xlUp
Range("B:Q,S:W,Y:AF").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
'シート名変更・挿入
ActiveSheet.Name = "CSV"
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "売利集計"
Set ws = Worksheets("売利集計")
wS.Cells.ClearContents
ws.Range("B1").Value = Worksheets("CSV").Range("B1")
ws.Range("C1").Value = Worksheets("CSV").Range("C1")
With Worksheets("CSV")
.Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("A1"), unique:=True
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
With Range(ws.Cells(2, "B"), ws.Cells(lastRow, "B"))
.Formula = "=SUMIF(CSV!A:A,A2,CSV!B:B)"
.Value = .Value
End With
With Range(ws.Cells(2, "C"), ws.Cells(lastRow, "C"))
.Formula = "=SUMIF(CSV!A:A,A2,CSV!C:C)"
.Value = .Value
End With
End With
Application.ScreenUpdating = True
Set ws = Nothing
MsgBox "売利集計完了しました。"
End Sub


Sub test2()
Dim i As Long
Dim lastRow As Long
Dim ws As Worksheet
Dim c As Range
Dim dicS As Object
Dim dicP As Object

Application.ScreenUpdating = False
'不要データ削除
Rows("1:3").Select
Selection.Delete Shift:=xlUp
Range("B:Q,S:W,Y:AF").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
'シート名変更・挿入
ActiveSheet.Name = "CSV"
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "売利集計"
'番号別集計
Set ws = Worksheets("売利集計")
Set dicS = CreateObject("Scripting.Dictionary")
Set dicP = CreateObject("Scripting.Dictionary")
With Sheets("CSV")
For Each c In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
dicS(c.Value) = dicS(c.Value) + Val(c.Offset(, 1).Value)
dicP(c.Value) = dicP(c.Value) + Val(c.Offset(, 2).Value)
Next
With Worksheets("売利集計")
.Columns("A:C").ClearContents
.Range("A1").Resize(, 3).Value = Worksheets("CSV").Range("A1").Resize(, 3).Value
.Range("A2").Resize(dicS.Count).Value = WorksheetFunction.Transpose(dicS.keys)
.Range("B2").Resize(dicS.Count).Value = WorksheetFunction.Transpose(dicS.Items)
.Range("C2").Resize(dicP.Count).Value = WorksheetFunction.Transpose(dicP.Items)
End With
End With
Set dicS = Nothing
Set dicP = Nothing
MsgBox "売利集計完了しました。"
End Sub

投稿日時 - 2017-02-27 10:48:18

QNo.9298764

困ってます

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

>データの行数が3万5千行ほどあるため、処理が終わるのに3分程かかります。
この辺に注目して、別の方法でやってみました。ご参考に。
こういう方法もあるということと、時間はそんなにかからないように思いました。
いわば、ソート法というものです。
ーー
シートはSheet1,Sheet2の2つ
(1)モジュールtest01()
乱数でSheet1のA列に番号、B列に金額を入れました。
5万行の例。
(2)test02()
Sheet1のA列をソートキーとして、A,B列をソートしました。
(3)Sheet1のA列で、番号が重複している番号について、
B列の金額の小計をSheet2のC列に出しています。A列は番号
B列は金額です。
ーー
Sub test01()
Set ws1 = Worksheets("Sheet1")
ws1.Range("A1:B50000").Clear
For i = 1 To 50000
ws1.Cells(i, "A") = WorksheetFunction.RandBetween(1, 500000)
ws1.Cells(i, "B") = WorksheetFunction.RandBetween(1, 100)
Next i
End Sub
ーーー
Sub test02()
Set ws1 = Worksheets("Sheet1")
ws1.Range("A1:B50000").Sort key1:=ws1.Range("A1"), order1:=xlAscending
End Sub
ーーー
Sub test03()
Debug.Print Time
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
ws2.Range("A1:C50000").Clear
renzok = "N"
j = 1
For i = 1 To 50000 - 1
If ws1.Cells(i, "A") = ws1.Cells(i + 1, "A") Then
ws2.Cells(j, "A") = ws1.Cells(i, "A")
ws2.Cells(j, "B") = ws1.Cells(i, "B")
j = j + 1
t = t + ws1.Cells(i, "B")
renzok = "Y"
Else
If renzok = "Y" Then
t = t + ws1.Cells(i, "B")
ws2.Cells(j, "A") = ws1.Cells(i, "A")
ws2.Cells(j, "B") = ws1.Cells(i, "B")
ws2.Cells(j, "C") = t
t = 0
j = j + 1
renzok = "N"
End If
End If
Next i
Debug.Print Time
End Sub
ーーー
私のやった例で
Sheet2の最終結果の一部見本
番号  計数  同番号合計
49907681
49907676157
4994719*
49947198*
49947156*
49947198261*
49947743
4994774689
49965280
49965255135

投稿日時 - 2017-02-27 20:06:27

お礼

imogasi 様
お礼が遅くなり、申し訳ありません。
ご回答ありがとうございます。

こういう方法もあるということを教えていただけると、大変勉強になります。
実際に試してみましたが、おっしゃるとおり、そんなに時間はかかりませんでした。

投稿日時 - 2017-03-02 11:43:48

ANo.1

こんにちは
エラーも出ることなく処理できているならそれでいいとは思いますが、
Dictionaryの前にSelectせずに処理するコードにする事と、ピボットテーブルで
処理する方法もコード化して比較してみてはどうですか?
CSVに不要な行が無ければADO接続してSQL文で集計する事も出来ますので
比較してみては?

投稿日時 - 2017-02-27 11:32:01

お礼

ushi2015 様
お礼が遅くなり、申し訳ありません。
ご回答ありがとうございます。

ピボットテーブルで処理する方法を試してみたところ、データが多くても意外と処理が速かったことに驚きました。
今回の場合は処理後のデータをさらに使用するので、ピボットテーブルの集計データだと扱いづらいため採用はしませんが、便利な機能だということを改めて感じました。

投稿日時 - 2017-03-02 11:39:25

あなたにオススメの質問