[[20070910230243]] 『集計表』(HARU) ページの最後に飛ぶ

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

 

『集計表』(HARU)
エクセルのバージョン:Excel2000
OS:WindowsXP

シート1に個々の品名を入力していって、シート2にシート1の合計の集計を出したい。
同じ品名のものがあれば数量を増加し、なければ行に新しく入力させたい場合の
マクロを教えてください。
シート1はFOR NEXTで考えましたが、シート2の場合は毎回2行目から検索するので
FOR NEXTは使えませんよね???よろしくお願いします。

例)
シート1

     A        B
 _________
1 品 名 |数量|
2 りんご |5  |
3 みかん |2  |  
4 ぶどう |1  |
5 りんご |1  |
6 りんご |3  |
7 ぶどう |2  |

シート2

     A        B
 _________
1 品 名 |数量|
2 りんご |9  |
3 みかん |2  |  
4 ぶどう |3  |
5     |   |
6     |   |
7     |   |


 作ってみました。
 試してください。
  (SHIOJII)

 Option Explicit

 Sub test()
    Dim myRng As Range
    Dim myDic As Object
    Dim r As Range

    Set myDic = CreateObject("Scripting.Dictionary")
    With Sheets("Sheet1")
        Set myRng = .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
    End With
    For Each r In myRng
        myDic(r.Value) = myDic(r.Value) + r.Offset(, 1).Value
    Next

    With Sheets("Sheet2")
         .Cells.ClearContents
         .Range("A1:B1").Value = Sheets("Sheet1").Range("A1:B1").Value
         With .Range("A2").Resize(myDic.Count)
              .Value = Application.Transpose(myDic.Keys)
              .Offset(, 1).Value = Application.Transpose(myDic.Items)
         End With
    End With
    Set myDic = Nothing
 End Sub


SHIOJIIさん
ありがとうございました。
上記マクロで集計表を作成する事が出来ました。
もし、品名以外にも同じになる条件が複数あったとしたらどうなりますか?
(HARU)

 横から失礼します。

 >もし、品名以外にも同じになる条件が複数あったとしたらどうなりますか?
 具体的には?

 参考URL
 Excel(エクセル) VBA入門:Dictionaryオブジェクトを利用する
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_dictionary.html
 2つの条件で合計する が参考になるかもです。
 (じゅんじゅん)

 Sub SAMPLE1()
   Dim I As Long, J As Long
   Sheet2.Cells(1, 1) = Sheet1.Cells(1, 1): Sheet2.Cells(1, 2) = Sheet1.Cells(1, 2)
   For I = 2 To 1000
     If (Sheet1.Cells(I, 1) = "") Then Exit For
     For J = 2 To 300
       If (Sheet2.Cells(J, 1) = "") Then
         Sheet2.Cells(J, 1) = Sheet1.Cells(I, 1)
         Sheet2.Cells(J, 2) = Sheet1.Cells(I, 2)
         Exit For
       End If
       If (Sheet1.Cells(I, 1) = Sheet2.Cells(J, 1)) Then
         Sheet2.Cells(J, 2) = Sheet2.Cells(J, 2) + Sheet1.Cells(I, 2)
         Exit For
       End If
     Next J
   Next I
 End Sub

 こちらも横から失礼します。
 マクロではありませんが、VBでプログラムを作ってみました。
 よかったらこちらも参考にしてみて下さい。
             (mr_mangoos)

コメント返信:

[ 一覧(最新更新順) ]


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