[[20161115142458]] 『データ数15万位と6万位の重複データの合計』(マクロ超初心者) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『データ数15万位と6万位の重複データの合計』(マクロ超初心者)

過去の記事(20120330185516『重複データの合計』(WWF))で作りたいマクロの内容は分かったのですが、
実際に動かしたところ、データ量が多く、固まってしまいました。
動きを早くするコードを見つけましたが、どこに入れればよいのかわかりません。

どのように変更すればいいでしょうか?
または、全く別のアプローチがあるのでしょうか?

エクセルマクロに関するネットを見たり、本を買って基礎から勉強しようとしましたが、育児の時短勤務で家でも時間が取れません。
お知恵を頂ければと思います。

<内容>
A列に商品名 B列に個数 がある表で
A列の商品名が多数重複しています
元となるデータには15万件位の商品データがあり、
照合するデータには6万件位の商品データがあります。

 商品名は その都度 取込みデータで 毎回違います。

元となるデータの末尾に照合するデータをコピペしてデータを作り
重複している商品は すべての合計数を
重複していない商品は その横の数を
C,D列 もしくは 別シートに出したい。

    A   B
 1  あ  2
 2 あ  5
 3 い  1
 4 う  2
 5 う  3
 6 う  1
 7 え  5

  ↓↓このようにしたいです
   C    D
 1 あ   7
 2 い   1
 3 う   6
 4 え   5

<過去ログで見つけたマクロ>
Sub Sample()

    Dim c As Range
    Dim dic As Object

    Set dic = CreateObject("Scripting.Dictionary")

    With Sheets("Sheet1")
        For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
            dic(c.Value) = dic(c.Value) + Val(c.Offset(, 1).Value)
        Next
        .Columns("C:D").ClearContents
        .Range("C1").Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.keys)
        .Range("D1").Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.items)
    End With

 End Sub

長くなりましたが、宜しくお願いいたします。

< 使用 Excel:Excel2010、使用 OS:Windows7 >


結果をまとめてセットしていますし、結構速そうなコーディングですよ? データが多すぎではないかと。
とりあえず、DB案を出してみます。 まず、1行目を追加し、以下のようにタイトル行を追加してください。

	A	B
1	F1	F2
2	あ	2
3	あ	5
4	い	1
5	う	2
6	う	3
7	う	1
8	え	5

マクロは以下。いったんブック保存してから実行してください。

 Sub test()
    Dim dic As Object
    Dim CN As Object
    Dim RS As Object

    Set dic = CreateObject("Scripting.Dictionary")
    Set CN = CreateObject("ADODB.Connection")
    Set RS = CreateObject("ADODB.Recordset")
    CN.Provider = "Microsoft.ACE.OLEDB.12.0"
    CN.Properties("Extended Properties") = "Excel 12.0"
    CN.Open ThisWorkbook.FullName

    Set RS = CN.Execute("SELECT F1,SUM(F2) as 計 FROM [Sheet1$] GROUP BY F1;")
    While RS.EOF = False
        dic.Add RS("F1").Value, RS("計").Value
        RS.MoveNext
    Wend
    Set RS = Nothing
    CN.Close
    Set CN = Nothing

    Columns("C:D").ClearContents
    Range("C2").Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.keys)
    Range("D2").Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.items)
    Set dic = Nothing
 End Sub
(???) 2016/11/15(火) 15:41

返信ありがとうございます。
データが多すぎるとは自分でも思っていますが、
商品データなので色・サイズなどで膨大な数になってしまいます(涙)

早速試してみましたが、

 実行時エラー13
 型が一致しません。
と出ました。

デバックを押したところ

   Range("C2").Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.keys)
が黄色になりました。

対処法を教えて頂けると幸いです。

(マクロ超初心者) 2016/11/15(火) 16:45


エラーの際、dic.Count は幾つになっていますか? 元のコードを活かしたので、そこは悩まないかと思ったのですが。

気になる点としては、対象のデータのあるシート名は Sheet1 である前提であること。 違うならば、[Sheet1$] と書いている中の、Sheet1 の部分を、実際のシート名に変えてください。
1行目の F1 F2 というタイトル名も、全角半角の違いなく入力しているか確認してください。SQL文の中で、これを決め打ちしています。
(???) 2016/11/15(火) 16:55


実行時エラー'13'になる条件が判りました。
Sheet1は確かに存在している。タイトル行は正しく F1 F2 にしている。しかし、データが1件もない。こういう場合です。

現在のシートを見るのではなく、保存してある自ブックをデータベースとして開くので、データがある状態で、一旦ブック保存してから実行すれば動くと思います。
(???) 2016/11/15(火) 17:20


データが無い場合でもエラーにならないよう修正した版です。

 Sub test()
    Dim dic As Object
    Dim CN As Object
    Dim RS As Object

    Set dic = CreateObject("Scripting.Dictionary")
    Set CN = CreateObject("ADODB.Connection")
    Set RS = CreateObject("ADODB.Recordset")
    CN.Provider = "Microsoft.ACE.OLEDB.12.0"
    CN.Properties("Extended Properties") = "Excel 12.0"
    CN.Open ThisWorkbook.FullName

    Set RS = CN.Execute("SELECT F1,SUM(F2) as 計 FROM [Sheet1$] WHERE F1 IS NOT NULL GROUP BY F1;")
    While RS.EOF = False
        dic.Add RS("F1").Value, RS("計").Value
        RS.MoveNext
    Wend
    Set RS = Nothing
    CN.Close
    Set CN = Nothing

    Columns("C:D").ClearContents
    If 0 < dic.Count Then
        Range("C2").Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.keys)
        Range("D2").Resize(dic.Count).Value = WorksheetFunction.Transpose(dic.items)
    End If
    Set dic = Nothing
 End Sub
(???) 2016/11/15(火) 17:25

 なつかしいですね。今はなき(? まだ生きてます。念のため)友人のぶらっとのコードですか。

 Transpose がおもいのでしょうかね。
 さらに、Transpose は(少なくとも現段階では)要素数が 65536 を超えると(もう少し少なかったかな?)不具合がでます。

 そちらの実データ、最終的に 6万件ぐらいということは、やばいですよね。

 ぶらっとのコードで Transpose をなくしたものを以下。試してはいません。どんなもんでしょうかね。

 Sub Sample2()
    Dim c As Range
    Dim dic As Object
    Dim v As Variant
    Dim i As Long
    Dim k As Variant

    Set dic = CreateObject("Scripting.Dictionary")

    With Sheets("Sheet1")
        For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
            dic(c.Value) = dic(c.Value) + Val(c.Offset(, 1).Value)
        Next
        ReDim v(1 To dic.Count, 1 To 2)
        For Each k In dic
            i = i + 1
            v(i, 1) = k
            v(i, 2) = dic(k)
        Next

        .Columns("C:D").ClearContents
        .Range("C1").Resize(dic.Count, 2).Value = v

    End With

 End Sub

(β) 2016/11/15(火) 18:00


 本題じゃないんですけど、どうも
 ここが引っかかるんですけど。
  ↓
 >元となるデータには15万件位の商品データがあり、 
 >照合するデータには6万件位の商品データがあります。 
 >
 > 商品名は その都度 取込みデータで 毎回違います。
 >元となるデータの末尾に照合するデータをコピペしてデータを作り 

 「元となるデータ」と「照合するデータ」の2種があるのに、やっている事は
 「元となるデータ」が計21万件あるのと同じ処理にしている。

 そう言う状況なら、普通「元となるデータ」が2つある、と言うハズだし、
 実際、順次処理していけばいいので、わざわざコピペして一つにする必要性も感じないです。
 (ピボットなんか使う前提なら別ですけど)

(半平太) 2016/11/15(火) 19:25


 質問文は、全く読んでいなかったんですが、半平太さんの指摘を受けて読んでみると、確かにへんですね。

 アップされたサンプルでは、元が1つとか、2つとか、そんなことではなく、
 単純に A列の重複をなくして B列の合計値をセットするように受け取れましたけど。

 元の下に比較する元ネタ(これが、どんなもので、どんな役割なのか全く見えないですけど)を貼り付けて
 それで、何をしようとしているんでしょうね。

 その目的によっては、そもそも、さがしあてられた、ぶらっとのコードそのものが、本件には使えないものかもしれません。

 ところで、単純に A列の重複をなくして B列の数値合計にする という要件だとしたら、何十万件といったもので
 試したことはありませんが、タイトル行をつけてピボットでは、だめなんでしょうかね?

(β) 2016/11/15(火) 19:37


返信が遅くなり申し訳ございません。
???様、β様ありがとうございます。

???様の修正版はまたエラーコードが出ました。

β様のSample2を試したところ、求めていたデータの処理が出来ました。

半平太様のご指摘の部分ですが、質問文が分かりづらかったようですみません。
問屋Aの在庫データA(約15万件)のCSVファイルと問屋Bの在庫データB(約6万件)CSVファイルがあります。
A列にはJANコード、B列には個数です。

在庫データAを「元となるデータ」として、そこに在庫データBを照合しようとしています。

データAにしかない商品、データBにしかない商品、データAとデータBの両方にある商品があるので、
(1)A・Bそれぞれにしかない商品のJANと数量はそのままC列とD列に表示
(2)重複している商品は数量を合算してC列とD列に表示

当初自分でコードを作ろうとしており、別のファイルやシートにあるデータを照合するコードを作るより
同じシートにあるデータを照合するほうが簡単かと思いましたが、息詰まりました。
そこでこちらの掲示板に行き着き、ぶらっと様のコードで自分のやりたいことが出来るのではないかと思いました。

実は在庫データBが手元になく、仮のデータでテストをしたので
今後問題が発生した際にはまたこちらでご相談させて下さい。

(マクロ超初心者) 2016/11/24(木) 14:41


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.