Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7149 / 13644 ツリー ←次へ | 前へ→

【40478】集計表について サン 06/7/14(金) 15:14 質問[未読]
【40490】Re:集計表について kobasan 06/7/14(金) 22:25 回答[未読]
【40568】Re:集計表について サン 06/7/18(火) 12:16 お礼[未読]
【40652】Re:集計表について kobasan 06/7/19(水) 18:48 回答[未読]
【40662】Re:集計表について サン 06/7/20(木) 9:55 お礼[未読]
【40732】Re:集計表について サン 06/7/21(金) 16:53 質問[未読]
【40739】Re:集計表について kobasan 06/7/21(金) 20:43 回答[未読]
【40747】Re:集計表について ichinose 06/7/22(土) 8:13 発言[未読]
【40755】Re:集計表について kobasan 06/7/22(土) 18:44 発言[未読]
【40759】Re:集計表について ichinose 06/7/23(日) 11:20 発言[未読]
【40825】Re:集計表について' kobasan 06/7/24(月) 20:16 発言[未読]
【40834】Re:集計表について' ichinose 06/7/24(月) 23:12 発言[未読]
【40902】Re:集計表について' kobasan 06/7/25(火) 22:45 お礼[未読]
【40782】Re:集計表について サン 06/7/24(月) 10:04 お礼[未読]
【40491】Re:集計表について Kein 06/7/14(金) 22:31 回答[未読]
【40569】Re:集計表について サン 06/7/18(火) 12:24 お礼[未読]
【40632】Re:集計表について Kein 06/7/19(水) 14:22 回答[未読]
【40633】Re:集計表について サン 06/7/19(水) 14:28 お礼[未読]

【40478】集計表について
質問  サン E-MAIL  - 06/7/14(金) 15:14 -

引用なし
パスワード
   御忙しい所申し訳ございません。

下記のような売上表を顧客名に別のシートにデータを
移したいのですがどうしたら宜しいでしょうか。
エクセルの集計を試してみましたが、コードの小計が出てきてしまい、
顧客名が表示されません。

教えて頂けますでしょうか。

シート1
コード  業種 顧客名 フリガナ     売上    消費税    合計
000001    04 ××  ××     5,000    250    5、250
000001    42 ××  ××     5,000    250    5、250    
000002    42 ○○      ××     1,000    50    1,050
000002  04 ○○  ××     1,000    50    1,050
 ・
 ・
 ・


シート2
コード  業種 顧客名 フリガナ     売上    消費税    合計
000001      ××  ××     10,000    500    10、500
000002      ○○  ××     2,000    100    2、100
 ・
 ・ 
 ・
とするのには、どうすれば宜しいでしょうか。

【40490】Re:集計表について
回答  kobasan  - 06/7/14(金) 22:25 -

引用なし
パスワード
   サン さん 今晩は。

私は、こんなのを見ると、すぐdictionaryを使いたくなるんです。
標準モジュールに貼り付けて使ってみてください。

Sub 集計3()
Dim vnt, a
Dim i As Long
Dim dic As Object
  '
  With Sheets("Sheet1")
    vnt = .Range("G2", .Range("A65536").End(xlUp)).Value
  End With
  '
  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(vnt, 1)
    If Not dic.exists(vnt(i, 1)) Then
      ReDim a(6)
      a(0) = vnt(i, 1)
      a(1) = vnt(i, 2)
      a(2) = vnt(i, 3)
      a(3) = vnt(i, 4)
    Else
      a = dic(vnt(i, 1))
    End If
    a(4) = a(4) + vnt(i, 5)
    a(5) = a(5) + vnt(i, 6)
    a(6) = a(6) + vnt(i, 7)
    dic(vnt(i, 1)) = a
  Next i
  '-----結果出力
  With Sheets("Sheet2")
    .Cells.ClearContents
    .Range("A1").Resize(, 7).Value = Array("コード", "業種", _
          "顧客名", "フリガナ", "売上", "消費税", "合計")
    .Range("A2").Resize(dic.Count, 7).Value = Application _
          .Transpose(Application.Transpose(dic.items))
    .Select
  End With
  '
  Erase vnt
  Set dic = Nothing
End Sub


>下記のような売上表を顧客名に別のシートにデータを

>シート1
>コード  業種 顧客名 フリガナ     売上    消費税    合計
>000001    04 ××  ××     5,000    250    5、250
>000001    42 ××  ××     5,000    250    5、250    
>000002    42 ○○      ××     1,000    50    1,050
>000002  04 ○○  ××     1,000    50    1,050
> ・
> ・
> ・
>
>
>シート2
>コード  業種 顧客名 フリガナ     売上    消費税    合計
>000001      ××  ××     10,000    500    10、500
>000002      ○○  ××     2,000    100    2、100
> ・
> ・ 
> ・
>とするのには、どうすれば宜しいでしょうか。

【40491】Re:集計表について
回答  Kein  - 06/7/14(金) 22:31 -

引用なし
パスワード
   集計は、ワークシート関数の SUMIF を使う方法もありますが、
Excelには集計機能というものもあるので、それを使って・・

Sub My集計()
  Dim Sh As Worksheet

  Set Sh = Worksheets(2)
  Application.ScreenUpdating = False
  With Worksheets(1)
   With .Range("A1").CurrentRegion
     .Sort Key1:=.Range("C1"), Order1:=xlAscending, _
     Header:=xlYes, Orientation:=xlSortColumns
     .Subtotal 3, xlSum, Array(5, 6, 7)
   End With
   With .Range("B2", .Range("B65536").End(xlUp).Offset(1)) _
   .SpecialCells(4)
     Intersect(.EntireRow, Range("A:D")).FormulaR1C1 = _
     "=R[-1]C"
     .EntireRow.Copy
     Sh.Range("A2").PasteSpecial xlPasteValues
   End With
   Application.CutCopyMode = False
   .Cells.RemoveSubtotal
   .Rows(1).Copy
   Sh.Range("A1").PasteSpecial xlPasteValues
  End With
  Sh.Activate: Sh.Range("A1").Select
  With Application
   .CutCopyMode = False
   .ScreenUpdating = True
  End With
  Set Sh = Nothing
End Sub

で、どうかな ?

【40568】Re:集計表について
お礼  サン E-MAIL  - 06/7/18(火) 12:16 -

引用なし
パスワード
   ▼kobasan さん:
おはようございます。

夜遅くまで申し訳ございませんでした。
集計が出来ました。
本当に有難うございます。

お伺いしたいのですが、
ReDim a(6)
>      a(0) = vnt(i, 1)
>      a(1) = vnt(i, 2)
>      a(2) = vnt(i, 3)
>      a(3) = vnt(i, 4)
>    Else
>      a = dic(vnt(i, 1))
>    End If
>    a(4) = a(4) + vnt(i, 5)
>    a(5) = a(5) + vnt(i, 6)
>    a(6) = a(6) + vnt(i, 7)
>    dic(vnt(i, 1)) = a
>  Next i

の式は、どういう事を指令しているのか
教えて頂けますでしょうか。
今後の勉強の参考にしたいので
ご面倒なのですが、教えて頂けますでしょうか。

御忙しい所、申し訳ございません。


>サン さん 今晩は。
>
>私は、こんなのを見ると、すぐdictionaryを使いたくなるんです。
>標準モジュールに貼り付けて使ってみてください。
>
>Sub 集計3()
>Dim vnt, a
>Dim i As Long
>Dim dic As Object
>  '
>  With Sheets("Sheet1")
>    vnt = .Range("G2", .Range("A65536").End(xlUp)).Value
>  End With
>  '
>  Set dic = CreateObject("Scripting.Dictionary")
>  For i = 1 To UBound(vnt, 1)
>    If Not dic.exists(vnt(i, 1)) Then
>      ReDim a(6)
>      a(0) = vnt(i, 1)
>      a(1) = vnt(i, 2)
>      a(2) = vnt(i, 3)
>      a(3) = vnt(i, 4)
>    Else
>      a = dic(vnt(i, 1))
>    End If
>    a(4) = a(4) + vnt(i, 5)
>    a(5) = a(5) + vnt(i, 6)
>    a(6) = a(6) + vnt(i, 7)
>    dic(vnt(i, 1)) = a
>  Next i
>  '-----結果出力
>  With Sheets("Sheet2")
>    .Cells.ClearContents
>    .Range("A1").Resize(, 7).Value = Array("コード", "業種", _
>          "顧客名", "フリガナ", "売上", "消費税", "合計")
>    .Range("A2").Resize(dic.Count, 7).Value = Application _
>          .Transpose(Application.Transpose(dic.items))
>    .Select
>  End With
>  '
>  Erase vnt
>  Set dic = Nothing
>End Sub
>
>
>>下記のような売上表を顧客名に別のシートにデータを
>
>>シート1
>>コード  業種 顧客名 フリガナ     売上    消費税    合計
>>000001    04 ××  ××     5,000    250    5、250
>>000001    42 ××  ××     5,000    250    5、250    
>>000002    42 ○○      ××     1,000    50    1,050
>>000002  04 ○○  ××     1,000    50    1,050
>> ・
>> ・
>> ・
>>
>>
>>シート2
>>コード  業種 顧客名 フリガナ     売上    消費税    合計
>>000001      ××  ××     10,000    500    10、500
>>000002      ○○  ××     2,000    100    2、100
>> ・
>> ・ 
>> ・
>>とするのには、どうすれば宜しいでしょうか。

【40569】Re:集計表について
お礼  サン E-MAIL  - 06/7/18(火) 12:24 -

引用なし
パスワード
   ▼Kein さん:

夜遅くまで申し訳ございませんでした。
集計表有難うございました。
いつもいつも申し訳ございません。

お伺いしたいのですが
Range("B65536")の所なのですが
なぜ上のセルを選択しているのか
教えて頂けますでしょうか。
また、どの部分が集計機能の部分か
教えて頂けますでしょうか。

ご面倒な事を頼んでしまい
申し訳ございません。


>集計は、ワークシート関数の SUMIF を使う方法もありますが、
>Excelには集計機能というものもあるので、それを使って・・
>
>Sub My集計()
>  Dim Sh As Worksheet
>
>  Set Sh = Worksheets(2)
>  Application.ScreenUpdating = False
>  With Worksheets(1)
>   With .Range("A1").CurrentRegion
>     .Sort Key1:=.Range("C1"), Order1:=xlAscending, _
>     Header:=xlYes, Orientation:=xlSortColumns
>     .Subtotal 3, xlSum, Array(5, 6, 7)
>   End With
>   With .Range("B2", .Range("B65536").End(xlUp).Offset(1)) _
>   .SpecialCells(4)
>     Intersect(.EntireRow, Range("A:D")).FormulaR1C1 = _
>     "=R[-1]C"
>     .EntireRow.Copy
>     Sh.Range("A2").PasteSpecial xlPasteValues
>   End With
>   Application.CutCopyMode = False
>   .Cells.RemoveSubtotal
>   .Rows(1).Copy
>   Sh.Range("A1").PasteSpecial xlPasteValues
>  End With
>  Sh.Activate: Sh.Range("A1").Select
>  With Application
>   .CutCopyMode = False
>   .ScreenUpdating = True
>  End With
>  Set Sh = Nothing
>End Sub
>
>で、どうかな ?

【40632】Re:集計表について
回答  Kein  - 06/7/19(水) 14:22 -

引用なし
パスワード
   >なぜ上のセルを選択
上ではなくて、一つ下のセルです。(Offset(1, 0)なので)
集計機能を使うと、通常は各項目ごとの集計がデータの「一行下」に
追加されるため、そこまでの範囲を指定しているわけです。
>どの部分が集計機能の部分か


.Subtotal 3, xlSum, Array(5, 6, 7)

のコードが集計を使う部分です。引数の意味などは
「Subtotalメソッド」をヘルプで調べて下さい。

【40633】Re:集計表について
お礼  サン E-MAIL  - 06/7/19(水) 14:28 -

引用なし
パスワード
   ▼Kein さん:

解りやすくご返答頂き有難うございました。
いつも申し訳ございません。
とても勉強になります。
有難うございます。


>>なぜ上のセルを選択
>上ではなくて、一つ下のセルです。(Offset(1, 0)なので)
>集計機能を使うと、通常は各項目ごとの集計がデータの「一行下」に
>追加されるため、そこまでの範囲を指定しているわけです。
>>どの部分が集計機能の部分か
>↓
>
>.Subtotal 3, xlSum, Array(5, 6, 7)
>
>のコードが集計を使う部分です。引数の意味などは
>「Subtotalメソッド」をヘルプで調べて下さい。

【40652】Re:集計表について
回答  kobasan  - 06/7/19(水) 18:48 -

引用なし
パスワード
   今晩は。

Dictionary については、ヘルプを調べてみてください。
以下の説明でどうですか。


>>    If Not dic.exists(vnt(i, 1)) Then
       'vnt(i,1) が、Dictionary にkey として登録されてないとき

>>      ReDim a(6)
      'で、a(0)〜a(6)の7列分の配列を設定。

>>      a(0) = vnt(i, 1)
>>      a(1) = vnt(i, 2)
>>      a(2) = vnt(i, 3)
>>      a(3) = vnt(i, 4)
      'で、a(0)〜a(3) に1列から4列までのデータを格納

>>    Else
       'vnt(i,1) が、Dictionary にkey として登録されているとき

>>      a = dic(vnt(i, 1))
       'で、Dictionary に登録したdic(vnt(i, 1))を配列 a に戻す。
       '合計するため

>>    End If
>>    a(4) = a(4) + vnt(i, 5)
>>    a(5) = a(5) + vnt(i, 6)
>>    a(6) = a(6) + vnt(i, 7)
     'で、a(4)〜a(6) に5列から7列までの合計を格納

>>    dic(vnt(i, 1)) = a
     'で配列 a を、Dictionary に登録

>>  Next i
>
>の式は、どういう事を指令しているのか
>教えて頂けますでしょうか。

【40662】Re:集計表について
お礼  サン E-MAIL  - 06/7/20(木) 9:55 -

引用なし
パスワード
   ▼kobasan さん:

おはようございます。

御返答有難うございました。
丁寧なご回答でとても解りやすかったです。
お手数な事をお願いしてしまいまして、
申し訳ございませんでした。

今後とも宜しくお願い致します。

>今晩は。
>
>Dictionary については、ヘルプを調べてみてください。
>以下の説明でどうですか。
>
>
>>>    If Not dic.exists(vnt(i, 1)) Then
>       'vnt(i,1) が、Dictionary にkey として登録されてないとき
>
>>>      ReDim a(6)
>      'で、a(0)〜a(6)の7列分の配列を設定。
>
>>>      a(0) = vnt(i, 1)
>>>      a(1) = vnt(i, 2)
>>>      a(2) = vnt(i, 3)
>>>      a(3) = vnt(i, 4)
>      'で、a(0)〜a(3) に1列から4列までのデータを格納
>
>>>    Else
>       'vnt(i,1) が、Dictionary にkey として登録されているとき
>
>>>      a = dic(vnt(i, 1))
>       'で、Dictionary に登録したdic(vnt(i, 1))を配列 a に戻す。
>       '合計するため
>
>>>    End If
>>>    a(4) = a(4) + vnt(i, 5)
>>>    a(5) = a(5) + vnt(i, 6)
>>>    a(6) = a(6) + vnt(i, 7)
>     'で、a(4)〜a(6) に5列から7列までの合計を格納
>
>>>    dic(vnt(i, 1)) = a
>     'で配列 a を、Dictionary に登録
>
>>>  Next i
>>
>>の式は、どういう事を指令しているのか
>>教えて頂けますでしょうか。

【40732】Re:集計表について
質問  サン E-MAIL  - 06/7/21(金) 16:53 -

引用なし
パスワード
   ▼kobasan さん:

たびたび申し訳ございません。
WINDOWSでは、マクロが動くのですが
MACユーザーが使用したところ、

Set dic = CreateObject("Scripting.Dictionary")

の部分が黄色くなってしまいます。

知識不足で大変申し訳ございません。

御忙しい所大変申し訳ございませんが、
教えて頂けますでしょうか。


>今晩は。
>
>Dictionary については、ヘルプを調べてみてください。
>以下の説明でどうですか。
>
>
>>>    If Not dic.exists(vnt(i, 1)) Then
>       'vnt(i,1) が、Dictionary にkey として登録されてないとき
>
>>>      ReDim a(6)
>      'で、a(0)〜a(6)の7列分の配列を設定。
>
>>>      a(0) = vnt(i, 1)
>>>      a(1) = vnt(i, 2)
>>>      a(2) = vnt(i, 3)
>>>      a(3) = vnt(i, 4)
>      'で、a(0)〜a(3) に1列から4列までのデータを格納
>
>>>    Else
>       'vnt(i,1) が、Dictionary にkey として登録されているとき
>
>>>      a = dic(vnt(i, 1))
>       'で、Dictionary に登録したdic(vnt(i, 1))を配列 a に戻す。
>       '合計するため
>
>>>    End If
>>>    a(4) = a(4) + vnt(i, 5)
>>>    a(5) = a(5) + vnt(i, 6)
>>>    a(6) = a(6) + vnt(i, 7)
>     'で、a(4)〜a(6) に5列から7列までの合計を格納
>
>>>    dic(vnt(i, 1)) = a
>     'で配列 a を、Dictionary に登録
>
>>>  Next i
>>
>>の式は、どういう事を指令しているのか
>>教えて頂けますでしょうか。

【40739】Re:集計表について
回答  kobasan  - 06/7/21(金) 20:43 -

引用なし
パスワード
   サン さん 今晩は。

>WINDOWSでは、マクロが動くのですが
>MACユーザーが使用したところ、
>
>Set dic = CreateObject("Scripting.Dictionary")
>
>の部分が黄色くなってしまいます。
>

DictionaryはExcelの標準機能ではないのです。

MACもMAC上のExcelも持ってないので、はっきりしたことはいえませんが、
MACでは、Dictionaryは使えないかもしれませんね。

Windows上のExcelでは、Dictionaryの機能を

 Set dic = CreateObject("Scripting.Dictionary")

のコードで、 「Microsoft Scripting Runtime」というものを参照できるようにして
動かしています。

【40747】Re:集計表について
発言  ichinose  - 06/7/22(土) 8:13 -

引用なし
パスワード
   kobasan さん、サン さん おはようございます。

MACでDictinaryは使えません。
(MACの連想配列機能でもあればそれを使うということですが・・・)

kobasanさんのコードを手直しするなら、
Dictionaryの代わりにCollectionを使ったらよいかと思います。

この手の処理(重複データをまとめる処理)をするには、
Dictionaryほど便利ではありませんが、
ちょっとの工夫で同じことは出来ると思いますから、
検討してみて下さい


MacでCollectionが使えるか否かは確認していませんが、
Mac上で
sub test()
 dim col as new collection
end sub

これがエラーにならなければ、使えると思いますから、
確認してみて下さい。

【40755】Re:集計表について
発言  kobasan  - 06/7/22(土) 18:44 -

引用なし
パスワード
   サン さん、ichinoseさん  今晩は。

Dictionaryは便利ですね。

最近は、Collection はあまり使わなくなりました。
クラスモジュールのとき使うくらいくらいかな。

勉強ために、Collection を使ってみるのもいいかもしれません。

また何かのときよろしくお願いします。

【40759】Re:集計表について
発言  ichinose  - 06/7/23(日) 11:20 -

引用なし
パスワード
   こんにちは。
>
>Dictionaryは便利ですね。
>最近は、Collection はあまり使わなくなりました。
>クラスモジュールのとき使うくらいくらいかな。
ですねえ!!、実は、最初に使ったのがCollectionだったので
愛着と言うか・・。

でも、Dictionaryより、優れている点は?と
探してみてもないんですよねえ・・
(・Key以外にインデックスでもItemが取得できる
 ・For Each Obj・・で、Objに型が指定できる
 は気が付きましたが、これはDictionaryでも工夫すれば
 対応できますからねえ)

逆にDictionaryにしか出来ないことはご承知のとおり沢山ありますけどよね!!

検索の速さも10000件程度で試してみましたが、
たいした差はありませんが、それでも微妙にDictionaryの方が速い
と言う結果を確認しています。

でも、MacでCollectionが使用可能なら
WinとMacまでの互換性を考慮した場合、

Collectionを使うことの意義が確認できるので
これは、結果を待ちたいですね!!

【40782】Re:集計表について
お礼  サン E-MAIL  - 06/7/24(月) 10:04 -

引用なし
パスワード
   ▼kobasan さん

お世話になっております。

早々の御回答有難うございました。
とても勉強になります。
MACで動かせるようがんばりたいと想います。
何度も何度もすいませんでした。
有難うございました。


>サン さん 今晩は。
>
>>WINDOWSでは、マクロが動くのですが
>>MACユーザーが使用したところ、
>>
>>Set dic = CreateObject("Scripting.Dictionary")
>>
>>の部分が黄色くなってしまいます。
>>
>
>DictionaryはExcelの標準機能ではないのです。
>
>MACもMAC上のExcelも持ってないので、はっきりしたことはいえませんが、
>MACでは、Dictionaryは使えないかもしれませんね。
>
>Windows上のExcelでは、Dictionaryの機能を
>
> Set dic = CreateObject("Scripting.Dictionary")
>
>のコードで、 「Microsoft Scripting Runtime」というものを参照できるようにして
>動かしています。

【40825】Re:集計表について'
発言  kobasan  - 06/7/24(月) 20:16 -

引用なし
パスワード
   ichinose さん、皆さん 今晩は。

>ですねえ!!、実は、最初に使ったのがCollectionだったので
>愛着と言うか・・。

ということは、Collection で、結構、集計をしていたってことですね。


>でも、Dictionaryより、優れている点は?と
>探してみてもないんですよねえ・・

>でも、MacでCollectionが使用可能なら
>WinとMacまでの互換性を考慮した場合、
>
>Collectionを使うことの意義が確認できるので
>これは、結果を待ちたいですね!!

ということで、
MAC で Collection が使えるか待っていたんですが、待ちきれずに、
Collection 用に改造してみました。

それから、自分のスキルアップのために。

あー、初めて、Collection を使って集計してしまった。

どなたか、MAC の Excel で、この Collection版が使えるかどうか確認してみてください。
(まだ、サンさんが見ていたら、お友だちに確認してもらってください。)


Sub Collection集計()
Dim vnt, a, c
Dim i As Long
Dim MyColl As New Collection
  '
  With Sheets("Sheet1")
    vnt = .Range("G2", .Range("A65536").End(xlUp)).Value
  End With
  '
  On Error Resume Next
  For i = 1 To UBound(vnt, 1)
    'Collectionにkey ,Itemを追加
    MyColl.Add Item:= _
      Array(vnt(i, 1), vnt(i, 2), vnt(i, 3), vnt(i, 4), _
      vnt(i, 5), vnt(i, 6), vnt(i, 7)), key:=vnt(i, 1)
    If Err.Number <> 0 Then
      '重複のとき
      a = MyColl(vnt(i, 1))
      MyColl.Remove vnt(i, 1)
      a(4) = a(4) + vnt(i, 5)  '集計
      a(5) = a(5) + vnt(i, 6)
      a(6) = a(6) + vnt(i, 7)
      MyColl.Add Item:=a, key:=vnt(i, 1)
    End If
    Err.Number = 0
  Next
  On Error GoTo 0
  '
  '-----出力用配列を作成
  i = 1
  ReDim outvnt(1 To MyColl.Count)
  For Each c In MyColl
    outvnt(i) = c
    i = i + 1
  Next
  '
  '-----結果出力
  With Sheets("Sheet2")
    .Cells.ClearContents
    .Range("A1:G1").Value = Sheets("Sheet1").Range("A1:G1").Value
    .Range("A2").Resize(MyColl.Count, UBound(vnt, 2)).Value = _
      Application.Transpose(Application.Transpose(outvnt))
    .Select
  End With
  '
  Erase vnt: Erase outvnt
  For i = 1 To MyColl.Count
    MyColl.Remove 1
  Next
End Sub

【40834】Re:集計表について'
発言  ichinose  - 06/7/24(月) 23:12 -

引用なし
パスワード
   こんばんは。

>ということは、Collection で、結構、集計をしていたってことですね。
まあ、クラスを通しての集計ですけどね!!

CollectionのItemに直接配列などを指定すると
書き換えが出来ないため、Removeして再度 Addしなければなりません。
これ、データが多いとちょっと時間がかかります。

Itemとしてクラスで定義したオブジェクトを登録します。
こうすると、オブジェクトのプロパティは変更ができます。

新規ブックの
クラスモジュール(Class1)に
'===================================================
Private a(6) As Variant
'=========================
Property Get myarray(i)
 myarray = a(i)
End Property
'=================================
Property Let myarray(i, myvalue)
 a(i) = myvalue
End Property
'=================================
Function get_array()
  get_array = a()
End Function


標準モジュールに
'======================================================
Sub 集計3()
  Dim vnt
  Dim cls As Class1
  Dim i As Long
  Dim col As Collection
  Dim chk_exsist As Variant  '
  Call mk_sample
  DoEvents
  MsgBox "サンプル作成"
  With Sheets("Sheet1")
    vnt = .Range("g2", .Range("A65536").End(xlUp)).Value
  End With
  On Error Resume Next '
  Set col = New Collection
  For i = 1 To UBound(vnt, 1)
    Err.Clear
    Set chk_exsist = col(CStr(vnt(i, 1)))
    If Err.Number <> 0 Then
     Set cls = New Class1
     With cls
      .myarray(0) = vnt(i, 1)
      .myarray(1) = vnt(i, 2)
      .myarray(2) = vnt(i, 3)
      .myarray(3) = vnt(i, 4)
       End With
     col.Add cls, CStr(vnt(i, 1))
     End If
    With col(CStr(vnt(i, 1)))
     .myarray(4) = .myarray(4) + vnt(i, 5)
     .myarray(5) = .myarray(5) + vnt(i, 6)
     .myarray(6) = .myarray(6) + vnt(i, 7)
     End With
  Next i
  '-----結果出力
  With Sheets("Sheet2")
    .Cells.ClearContents
    .Range("A1").Resize(, 7).Value = Array("コード", "業種", _
          "顧客名", "フリガナ", "売上", "消費税", "合計")
    For i = 1 To col.Count
      With .Range("a2")
       .Cells(i, 1).Resize(, 7).Value = col(i).get_array
       End With
      Next
    .Select
  End With
  '
  Erase vnt
  Set col = Nothing
End Sub
'====================================================================
Sub mk_sample()
  Dim g0 As Long
  With Worksheets("sheet1")
    .Cells.ClearContents
    .Range("A1").Resize(, 7).Value = Array("コード", "業種", _
          "顧客名", "フリガナ", "売上", "消費税", "合計")
  
    For g0 = 1 To 10000
     .Range("a1").Offset(g0, 0).Resize(, 7).Value = _
           Array((g0 Mod 300) + 1, 4, "ああ", "アア", g0 * 100, Int(g0 * 100 * 0.05), g0 * 100 + Int(g0 * 100 * 0.05))
     Next
    End With

End Sub


これで、mainを実行してみて下さい。

ブックの各シート(Sheet1とSheet2は用意して下さい)は
何も入力しないで下さい。

コードでSheet1にサンプルデータも作成します。


試してみて下さい。

【40902】Re:集計表について'
お礼  kobasan  - 06/7/25(火) 22:45 -

引用なし
パスワード
   ichinose さん こんばんは。

>CollectionのItemに直接配列などを指定すると
>書き換えが出来ないため、Removeして再度 Addしなければなりません。

初めて、Collectionで集計しようとすると、まず、この部分で引っかかりましたね。
それで、やむなく、Removeして再度 Addすることに気づいたわけですが、
Collectionの登録順が狂うのも分って、いやでしたが、とりあえず集計させるのが先決
でした。
「Removeして再度 Addすること」の部分はもっと、スマートな方法がないかと思っていました。


>Itemとしてクラスで定義したオブジェクトを登録します。
>こうすると、オブジェクトのプロパティは変更ができます。

この方法、今回勉強させてもらいました。


ichinoseさんのコードを見て、
まず私のコードで、!!vnt(i, 1)!!のところは、CStr(vnt(i, 1))に
直さなければいけないことが分りました。訂正しておきます。

私がやっている仕事程度では、データ数が少ないので、これでも使用に耐えます。
Collectionを使いはじめの人にとっては、分りやすいかな?と思ったりしています。

  On Error Resume Next
  For i = 1 To UBound(vnt, 1)
    'Collectionにkey ,Itemを追加
    MyColl.Add Item:= _
      Array(vnt(i, 1), vnt(i, 2), vnt(i, 3), vnt(i, 4), _
      vnt(i, 5), vnt(i, 6), vnt(i, 7)), key:=!!vnt(i, 1)!!
    If Err.Number <> 0 Then
      '重複のとき
      a = MyColl(!!vnt(i, 1)!!)
      MyColl.Remove !!vnt(i, 1)!!
      a(4) = a(4) + vnt(i, 5)  '集計
      a(5) = a(5) + vnt(i, 6)
      a(6) = a(6) + vnt(i, 7)
      MyColl.Add Item:=a, key:=!!vnt(i, 1)!!
    End If
    Err.Number = 0
  Next
  On Error GoTo 0

==============================

ichinoseさんのコードで、

  On Error Resume Next '
  Set col = New Collection
  For i = 1 To UBound(vnt, 1)
    Err.Clear
    Set chk_exsist = col(CStr(vnt(i, 1)))  <===A
    If Err.Number <> 0 Then
     Set cls = New Class1
     With cls          <==============B    
      .myarray(0) = vnt(i, 1)
      .myarray(1) = vnt(i, 2)
      .myarray(2) = vnt(i, 3)
      .myarray(3) = vnt(i, 4)
       End With
     col.Add cls, CStr(vnt(i, 1))
     End If
    With col(CStr(vnt(i, 1)))   <==============C
     .myarray(4) = .myarray(4) + vnt(i, 5)
     .myarray(5) = .myarray(5) + vnt(i, 6)
     .myarray(6) = .myarray(6) + vnt(i, 7)
     End With
  Next i

の部分のC,Bは、よく見ると、私には、結構時間をかけて、理解しないと行けない部分ですね。(クラスモジュールの方はわかるのですが、標準モジュールで使いまわすのが・・)

この部分が、

>Itemとしてクラスで定義したオブジェクトを登録します。
>こうすると、オブジェクトのプロパティは変更ができます。

にあたるのかな。

Aの部分は、なるほどですね。

今回もたくさん勉強うさせてもらいました。やっぱり投稿してみるもんですね。
また、何かありましたら、よろしくお願いします。有難うございました。

7149 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free