[[20030719095654]] 『集計の仕方を教えてくれませんか』(まーぶる) ページの最後に飛ぶ

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

 

『集計の仕方を教えてくれませんか』(まーぶる)

この様な場合どの様に集計したらよいんでしょうか?

シート1にこのようなデータがあるとして

 A   B   C  D

 1品番 号数 数量 単価 
 2 1  A   1  100
 3 1  B   5  100
 4 9  C   2  100
 5 1  A   3  100
 6 1  A   2  110

上記を
集計して シート2に表示したいのです

 品番 号数 数量  単価
  1  A   4   100 
  1  A   2   110
  1  B   5   100
  9  C   2   100

エクセルにある集計では
よけいなデータが入ってくる為
シート2に上記の並び方で表示したいのですが・・・

難しいのでしょうか?VBAでしか可能ではないってのは分かるんですけど・・・
どのたか教えていただけませんでしょうか?(-_-)
お願い致しますm(__)m


 ピボットでこんなふうにはできますけど...
 この形でもイヤならVBAになるかと思います。



 (e2d)ピボットテーブル入門
http://www.excel.studio-kazu.jp/lib/e2d/e2d.html

 ピボットテーブル
http://search.office.microsoft.com/japan/assistance/tasks.aspx?s=xlpivot&p=Excel 現在参照不可

 (ramrun)

 [ramrun]さん、いつもありがとう。
 画像があるとわかりやすいので、このボードにも採用したいなと思っています。
 とりあえず、暫定で画像ファイルを私のサーバー側に移しました。
 (kazu)

 画像の件了解しました。こちらの画像は消しました。
 でも画像を使いだすようになるとサーバー大丈夫ですか?(笑)
 (ramrun)

回答有難うございます。でも・・・やっぱりこの方法では・・・・
出来ればVBAで 表示するやり方教えていただけませんか?
宜しくお願い致します。

  ramrunさん忙しいんかしてなかなか返事もらえまへんなぁ。それとも追加注文見落と
 しとんとちゃいまっしゃろか?。
 ほんならここで横やり一本いっときまひょか。いいええな、このまま放っとったらこの
 質問状、だんだん下の方へ落ちて行ってしもうて目ぇに入らんようになるかもしれまへ
 さかい一丁紙面をにぎわして上の方へ押し上げときまっさ。
  お断りしときまっけど、正直とても上等のコードとは言えまへんけど、一応は動いて
 集計もあんじょうでけるのはでけまんねんで、ええ。
 そのうちramrunさんの目ぇに止まったら適切な指導をもらえる事請け合いですわ。
  我が輩、只今修行の身ですが、頭から馬鹿にせんと暇を見つけて試してみておくんな
 はれな。  ほな...  (おいぼれ弥太郎)

 Sub 集計()
    Set ws1 = Worksheets("sheet1")
    Set ws2 = Worksheets("sheet2")
    ws1.Activate
       Cnt = Cont
    ws1.Range(Cells(1, 1), Cells(Cnt, 4)).Copy
    ws2.Activate
    With ws2

    .Cells(1, 1).PasteSpecial Paste:=xlValues
    Application.CutCopyMode = xlCut
    .Range("a2:d9").Sort Key1:=Range("A2"), key2:=Range("b2"), _
             key3:=Range("d2")
    .Range("a1").Select
    i = 1
    n = 0
 hosino:
    Do While i <> Cnt - 1
        i = i + 1
        n = n + 1
        If .Cells(i, 1) = .Cells(i + n, 1) And .Cells(i, 2) = _
                   .Cells(i + n, 2) _
                    And .Cells(i, 4) = Cells(i + n, 4) Then
            .Cells(i, 3) = .Cells(i, 3) + .Cells(i + n, 3)
            .Range(Cells(i + n, 1), Cells(i + n, 4)).Clear
        ElseIf .Cells(i, 1) = "" Then
            n = 0
            GoTo hosino
        Else
            Exit Do
        End If
    Loop
    If i = Cnt - 1 Then
        For i = 2 To Cnt - 1
            If .Cells(i, 1) = "" Then
                .Range(Cells(Cnt, 1), Cells(Cnt, 4)).Insert _
                    Shift:=xlDown
            End If
        Next i
        .Range(Cells(2, 1), Cells(Cnt, 4)).SpecialCells _
                (xlCellTypeBlanks).Delete Shift:=xlUp
    Else
        n = 0
        GoTo hosino
    End If
    End With
 End Sub

 Function Cont() As Integer
    i = 1
        Do While Cells(i, 1) <> ""
            i = i + 1
        Loop
        Cont = i
 End Function


回答有難う御座います(>_<)

時間はかかると思いますがやってみます
なんせVBAなんてやったことないので・・・・

頑張ります!しかし、埋もれるかと内心心配してました(^.^)

ありがとうございました


  いえいえ何をおっしゃいますやら。
 しかしなんでんなあ、解答の良否は別としてこうやって返事をもらえるんは有り難いこ
 とでっせ、ええ。前にも書いたように私も修行の身ですさかい、なんぞ勉強になるもん
 無いかと思うてあちこちページめくってみまんねんけど、解答者の書き込みで終わっと
 るページがしばしば見受けられまんなあ。あれって正直不快感を覚えるんですけど、わ
 たしだけなんでっしゃろか?
  まあ、それはともかくコードの方へ戻りまひょか。Functionは引数さえつければいろ
 んなプロシージャから参照でけるんで敢えて使うたんですけど、利用すること無かった
 ら削除してCnt=Range("A1").End(xlDown).Row+1で十分です。1行余分に付け加えたん
 はSheet2の他のデータと区別するためです。
 それからSheet2に他のデータが入ってないんやったらLoopの下のFor〜Nextも消しても
 別状おまへん。ほんなところでんな、ええ。
  もうこの返事は要りまへんでぇ。熟達者が覗いて注文つけてくれるまでは...
  ほな....  (おいぼれ弥太郎)

 どうもお待たせしたようで...(汗)。
 弥太郎さんには感謝。
 VBAは確認させてもらったんですが、どうも同じ条件で集計できる行が
 3行以上あると駄目みたいでした。

 一応ここの風潮としては、なるべくVBAを使わないことが
 良しとされています。
 一般的な操作を見直せ〜 ということですね。
 たとえば私が紹介したピボットで表を作り、コピーして、
 値で貼り付ければ列の入れ替えなどの編集も出来ます。
 数量を号数と単価の間に移すことも可能です。

 ただ、一応VBAも作ってみました。
 変数は可変にしてあるので、表範囲が変化しても対応できると思います。
 表範囲は自動認識しますので、マクロを走らせる際は
 表内のセルのどこかをクリックしておきます。
 表外をクリックしていると結果がでません。
 あと可変対応のため、ソートしてません。
 出力後、自分でソートしてください(汗)。

 Constで出力シートがシート2、出力セル(表の左上)をB2にしています。
 適当に直してください。
 集計列は3行目(数量)ですが変更可能です。
 カウント開始番号は変えないでください。

 (ramrun)

 Option Base 1
 Const sum_fd As Integer = 3     '集計列No.
 Const OpSno As Integer = 2      '出力シート
 Const OpRng As String = "B2"    '出力セル
 Const st As Integer = 1         'カウント開始番号

 Sub macro()
    Dim flg As Boolean
    Dim cnt As Integer

    Set tbl = ActiveCell.CurrentRegion
    rc_max = tbl.Rows.Count
    fd_max = tbl.Columns.Count
    ReDim dbase(rc_max, fd_max) As Variant
    ReDim buf(fd_max) As Variant

    cnt = 1
    For tbl_rc = st To rc_max
        '抽出
        For fd = st To fd_max
            buf(fd) = tbl(tbl_rc, fd).Value
        Next fd

        '比較
        For rc = st To cnt
        flg = True
            For fd = st To fd_max
                If fd <> sum_fd Then
                    If dbase(rc, fd) <> buf(fd) Then
                        flg = False
                        Exit For
                    End If
                End If
            Next fd
            If flg = True Then Exit For
        Next rc

        '格納
        If flg = True Then
            dbase(rc, sum_fd) = dbase(rc, sum_fd) + buf(sum_fd)
        Else
            For fd = st To fd_max
                dbase(cnt, fd) = buf(fd)
            Next fd
            cnt = cnt + 1
        End If
    Next tbl_rc

    '出力
    Worksheets(OpSno).Select
    For rc = st To cnt - 1
        For fd = st To fd_max
            Range(OpRng).Offset(rc - 1, fd - 1) = dbase(rc, fd)
        Next fd
    Next rc

 End Sub

  あちゃーっ! ramrunさん、3行以上有ったらアカンのんよう見つけてくれはりまし
 たなあ、おおきにおおきに。
 大恥かくところでしたわ、ええ(もうかいてもとる)。
 まだ廻してまへんけど、参考にさして貰います、はい。(儲けたでぇ)

  まーぶるさん、まあこんな案配ですさかい私のコードをボツにしてramrunさんのコー
 ドに差し替えておくんなはれや。お手間取らせてすんまへんなぁ、ほんまに。(^^;)
  これも知らなんだ事ですけど、このコーナーは一般的な操作を趣旨としとるっちゅう
 事ですさかい、やたらVBAを押しつけるんは良うないみたいですわ、ええ。
 一般的な操作っちゅうてもこれまた広範囲に渡っていますさかいマスターするんに骨が
 おれまっせえ。かくいう我が輩も(貴殿より初心者に違いない)ビボットテーブルとか
 言うもんの存在すら知らんぐらいですから、こら性根入れて修行せんかったアカンと発
 憤しとりますわ。
  まあ、なんにしても、ramrunさんの解答もらえて良かった良かった。
   ほなら、また(もういらんヵ?)... (おいぼれ弥太郎)

 改訂版がでけた!!
 これではどないでっか?上手いこといくと思いまんねんけど!

 Sub 集計()
    Set ws1 = Worksheets("sheet1")
    Set ws2 = Worksheets("sheet2")
    ws1.Activate
       cnt = Cont
    ws1.Range(Cells(1, 1), Cells(cnt, 4)).Copy
    ws2.Activate
    With ws2

    .Cells(1, 1).PasteSpecial Paste:=xlValues
    Application.CutCopyMode = xlCut
    .Range("a2:d" & cnt - 1).Sort Key1:=Range("A2"), _
         key2:=Range("b2"), key3:=Range("d2")
    .Range("a1").Select
    i = 1
    Do
        i = i + 1
        If .Cells(i, 1) = "" Then
            Exit Do
        End If
        If .Cells(i, 1) = .Cells(i + 1, 1) And .Cells(i, 2) = _
                   .Cells(i + 1, 2) _
                    And .Cells(i, 4) = Cells(i + 1, 4) Then
            .Cells(i, 3) = .Cells(i, 3) + .Cells(i + 1, 3)
            .Range(Cells(i + 1, 1), Cells(i + 1, 4)) _
                    .Delete shift:=xlUp
            i = i - 1
        End If
    Loop While .Cells(i, 1) <> ""
    End With
 End Sub

 Function Cont() As Integer
    i = 1
        Do While Worksheets("sheet1").Cells(i, 1) <> ""
            i = i + 1
        Loop
        Cont = i
 End Function

       (執念のおいぼれ弥太郎)


(おいぼれ弥太郎さん)ならびに(ramrunさん)有難う御座います(T_T)

せっかく、こうして教えていただいているのですが
仕事が忙しくてする時間もありません(T_T)
ですが絶対参考にさせていただきます。(>_<)

 PS、(解答者の書き込みで終わっと るページがしばしば見受けられまんなあって)
    って本当に失礼だと思います!
    せっかく回答者の方が時間をさいてまで書き込みしてくれて頂いてるのに(-_-メ)

    

    (やたらVBAを押しつけるんは良うないみたいですわ)
    (なるべくVBAを使わないことが良しとされています。)
        以後気をつけます(^^ゞ

 もう一度 有難う御座いましたm(__)m

 せっかくですから弥太郎さんのを見させてもらいました。

 Doの比較のところ、
 If .Cells(i, 1) = .Cells(i + n, 1) And 〜
 は
 If .Cells(i, 1) = .Cells(i + 1, 1) And 〜
                             ↑
 ではないですか?
 なんだか、最後の1つのレコード処理が行われていなかったようなので...
 それで万事うまく動くと思います。

 私も普段、自分用のVBAを組むときは弥太郎さんと同じようなやり方を
 します。

 ついでに私のもちょっぴり修正。 でも変数の宣言中途半端(汗)。

 最近は1つのスレが伸びますね〜

 (ramrun)

  はーい、ご指摘の通りですわ。またまたチョンボやっとりました、ハイ(^^;)。
 なんやあちこちさわっとったら思いの外上手いこといったんで、舞い上がってしもて
 ろくに見直さんと書き込んでしまいましたわ。大いに反省してま。
  また、熟達者の望外のオスミツキもろうて嬉しいことこの上おまへん。私も昨日か
 ら貴殿のコードの黄色いマーク(あれなんちゅうんですかな?)を追いかけ回してま
 んねんけど途中で頭ん中がぐちゃぐちゃになってもて、また初めからやり直しの繰り
 返しですわ。せやけど何とかモノにしょうとがんばってまんねんで、ええ。

 >最近は1つのスレが伸びますね〜
 まーぶるさんの頭越しにキャッチボールしとるみたいで、彼には申し訳ないんですけど
 まあ、ramrunさんが二人の質問者を相手にしとるっちゅう事で堪忍して貰いまひょか。
  今後ともご教授頼んます。  (おいぼれ弥太郎)ご指摘の所は訂正済み

有難う御座います!しかしギャーって発狂しそうな位コードの意味が捉えられません(T_T)
そこでおいぼれ与太郎さん ramrunさんにお願いがあるのですが・・・・m(__)m
実は・・・BとCの間に品名が増えるのですが・・・
コードがまったく分からない私には変えようがありません(T_T)
そこでお願いなのですがこの件おしえて頂けないでしょうか
宜しくお願いします これが、最後のお願いです

 A   B   C    D   E

 1品番 号数 品名   数量 単価 
 2 1  A  カレー   1   100
 3 1  B  カレー   5   100
 4 9  C  らーめん  2   100
 5 1  A  カレー   3   100
 6 1  A  カレー   2   110

PS。(おいぼれ弥太郎)ramrunは師弟関係みたいですねー(^.^)


ごめんなさい、この質問の回答には全然関係無いですしVBA度素人の私には全く理解
出来ない世界なんですが、このやりとりを拝見しててとても参考になります。
これが「エクセルの学校」の最高に良いところだって実感しました。
ごめんなさい、お邪魔しました!(ヒロ)


  いやーヒロさんこんなとこで感心されたらなんやしらん身体がこそぼうなってきま
 すわ、ええ。
  ところでまーぶるさん。ご希望のコード書いときましたで。Functionは上のまま使う
 ておくんなはれ。それからSheet2のA欄には何のデータも入って無いっちゅうのが前提
 条件で書いてますさかい、もし入っとるんやったらご自分で考えて、Insertメソッドで
 影響を受けん様にしておくんなはれ。
 >(おいぼれ弥太郎)ramrunは師弟関係みたいですねー
 いやいや、とんでもおまへんわ、ええ。腕前の差からしたら、そうでんなあ、宮本武蔵
 と権爺程ちゃいますからなぁ、ほど遠い存在ですわ、腹ん立つほんまに(kore naisyo)
 ----
 Sub 集計2()
    Set ws1 = Worksheets("sheet1")
    Set ws2 = Worksheets("sheet2")
    Application.ScreenUpdating = False
    ws1.Activate
       cnt = Cont
    ws1.Range(Cells(1, 1), Cells(cnt, 5)).Copy
    ws2.Activate
    With ws2

    .Cells(1, 1).PasteSpecial Paste:=xlValues
    Application.CutCopyMode = xlCut
    .Range("a2:e" & cnt - 1).Sort Key1:=Range("a2"), _
         key2:=Range("b2"), key3:=Range("e2")
    .Range("a1").Select
    i = 1
    Do
        i = i + 1
        If .Cells(i, 1) = "" Then
            Exit Do
        End If
        If .Cells(i, 1) = .Cells(i + 1, 1) And .Cells(i, 2) = _
                .Cells(i + 1, 2) And .Cells(i, 3) = _
                .Cells(i + 1, 3) And .Cells(i, 5) = .Cells(i + 1, 5) Then
            .Cells(i, 4) = .Cells(i, 4) + .Cells(i + 1, 4)
            .Range(Cells(i + 1, 1), Cells(i + 1, 5)) _
                    .Delete Shift:=xlUp
            i = i - 1
        End If
    Loop While .Cells(i, 1) <> ""
    End With
    Application.ScreenUpdating = True

 End Sub
 ----
   ほなら...  (おいぼれ弥太郎)

 ふぅ〜 本日の仕事完了。
 ちょっと来週から8月末まで本当にコモリますので、
 このVBAについて聞きたいことありましたら、カキコしておいてください。

 私の方のコードは、
 集計列を左から数えて数量が4列目なら

 Const sum_fd As Integer = 4     '集計列No.

 3を4に変更すればOKです。

 ここでは回答者の皆さんがとても親切です。
 ある程度言葉足らずの質問でも、予想して答えてくれます。
 質問の仕方が悪かったからといってあきらめず、
 食らいついてください(謎)。

 回答者側に立っても正解を答える必要はありません。
 知っていることを、そのまま出せばいいんです。
 間違っていれば、もしくはもっと良い方法があれば
 誰かツッコミをくれるでしょう。
 結果的にそれは自分に知識としてかえってきます。

 あとは回答がつかないスレに無理やり回答する、
 そしてわからなくても、調べてでも答えようとする
 スレ上げ委員がいれば... だれか立候補しません?
 自己レベルアップは保障します。

 ここだけの話、ここは中級者の集まりです。
 だからおもしろいんですよ。
 互いに補完しあうし(エッチィ)。
 いろいろ変なことも考えますから(笑)。

 過去に質問していた方が、回答者側にまわってくれると
 うれしいものがありますね。

 (ramrun)長寿スレおめ

  コモりはるって、まさか修行にこもって我々と腕の差を更に広げようっちゅう魂胆と
 ちゃいまっしゃろなあ。ほんなん許されまへんでぇ、ったく。
  まあ何にしても食らいついていく相手が一人減るっちゅう事はちょっと寂しい8月に
 なりそうですわ、ええ。

  ところで、貴殿のコードは今んとこリカイのリ.までしか進んでまへんさかい、正直
 いちゃもんつけると言うか質問をぶつけるっちゅうか、まだそんな段階にいってまへん
 ねん(おそらくおまへんやろ)。

  またまたスレが伸びましたなぁ。kazuさんにことわり入れときまっさ。
   ほなら、また。  (おいぼれ弥太郎)

  <kazuさん>
 スレが伸びて申し訳おまへん。諸悪の根元はramrunにおまんねんでぇ、ええ。
 堪忍したっておくんなはれやぁ....。

 今回は最長記録でしょうね。
 ここまで、議論が進むとReadOnlyでも結構楽しめます。

 私がこの[エクセル質問ボード]にWikiを採用したのは、議論のはじめと経過と終わりを
 ひとまとめにしたかったからです。
 一般的な掲示板では、次々とたどってゆかなければなりません。

 ですから、スレが伸びて大きくなっても、ぜんぜん問題ありません。
 (kazu)

 と、私が根っこの元だったんですか? 気づきませんで...(笑)。

 弥太郎さんのと自分のを掛け合わせしたような感じに修正。
 変数もキチンと宣言しました。
 しかし例によってソートはしてません(汗)。

 最初は再帰的に処理してみようとか、
 Perlっぽく配列の添字をそのまま条件にして格納していこうかとか、
 思ったんですけど無難なところでユルシテ。

 上のコードも見直し。
 不必要にforで回しすぎなところがあって、不要ループ削除(汗)。

 (ramrun)では〜

 Option Base 1
 Option Explicit
 Const sum_fd As Integer = 4     '集計列No.
 Const OpSno As Integer = 2      '出力シート
 Const OpOff As String = "B2"    '出力セル
 Const st As Integer = 1         'カウント開始番号

 Sub macro()
    Dim flg As Boolean
    Dim tbl1, tbl2 As Variant
    Dim tbl1_rc, rc, rc_max, fd, fd_max, cnt As Integer

    Worksheets(OpSno).Cells.ClearContents

    Set tbl1 = ActiveCell.CurrentRegion
    rc_max = tbl1.Rows.Count
    fd_max = tbl1.Columns.Count

    Set tbl2 = Worksheets(OpSno).Range(tbl1.Address). _
        Offset(Range(OpOff).Row - 1, Range(OpOff).Column - 1)

    cnt = 1
    For tbl1_rc = st To rc_max
        '比較
        For rc = st To cnt
            flg = True
            For fd = st To fd_max
                If fd <> sum_fd Then
                    If tbl2(rc, fd) <> tbl1(tbl1_rc, fd) Then
                        flg = False
                        Exit For
                    End If
                End If
            Next fd
            If flg = True Then Exit For
        Next rc

        '出力
        If flg = True Then
            tbl2(rc, sum_fd) = tbl2(rc, sum_fd) + tbl1(tbl1_rc, sum_fd)
        Else
            For fd = st To fd_max
                tbl2(cnt, fd) = tbl1(tbl1_rc, fd)
            Next fd
            cnt = cnt + 1
        End If
    Next tbl1_rc

 End Sub

お久しぶりです弥太郎さんramrunさん

ありがとうございます。試してみましたら弥太郎さんできました!
ただ・・・ramrunさんのはなぜかエラーが発生してしまいます。
僕何か悪いことしてるんでしょうか????(??)
実行したら、動いているようなのですが・・・結果をみたらsheet2にゼロとだけ
表示されて正常に作動しませんでした。
弥太郎さんのは動きましたよ!(^^)
大事に使わせて頂きます。
弥太郎さんやramrunさんのコードを理解したいのですが
やはりどうしても分かりません(T T)くやしいっすねー
本当にみなさんにはお世話になりました
今回のやり取りで他の方もためになったってのが僕にとってはせめてもの慰めですわー
お時間ありがとうございました

PSずっと思ってたのですが・・・なぜに僕の字だけがでかい!のでしょうか(??)


 <まーぶるさん>
 ramrunさんのコード何で動かんのやろ?ちゃんと動きまんねんけどなぁ。まあ、コホンえ
 え方使うときなはれ。それに超したことおまへんでぇ、ええ。
 >ずっと思ってたのですが・・・なぜに僕の字だけがでかい!のでしょうか(??)
 ハイ、答えは明快です。貴殿がドクターの立場になれば判明いたします。つまり、その
 う、コホン (風邪やない)私ぐらいの腕前になれば(^^;)ちゅうことですわ。アーシンド

 あ、言い忘れてましてんけど、与太郎さんは止めとくんなはれや。なんや大店の放蕩息
 子のイメージがつきまとって、私しゃイヤや。

 <ramrunさん>
  ふーッ!今日は久しぶりに仕事してましてん。せやからこれも久しぶりにうまいビー
 ルを飲ませて貰いましたわ、ええ。
  いいええな、いつもは今頃の時間帯は一杯飲んでナイター観戦の佳境に入っとる時分
 (あれっ、これって与太郎モード?)でんねんけど、今日はナイターがおまへんさかい
 なぁ、インターネットいろてまんねんで。えっ?何処のファンて? ほんなん気の毒で
 口が裂けても言われへん。あっ言うてもた...

  あかん、与、余談はさておいて
 今度のコード、なんやえらいコンパクトになって、あれやったら黄色のマークを追いか
 けるんもそれほど悩まんでもええみたいでっせ、有り難い。私しゃこんなんが好き。

 >と、私が根っこの元だったんですか? 気づきませんで...(笑)。
  どんまい、どんまい。
 これはあくまで内緒の話ですねんけど、あのテクニックは(ramnokasa)言いまんねん。
 わかりまっしゃろ? ほら、あれを私の責任や言うたらkazuさんもあないに優しゅう
 扱うてくれしまへんでぇ、ほんまに。
  また使わせて貰います。ほな...(おいぼれ弥太郎)


コメント返信:

[ 一覧(最新更新順) ]


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