[[20170224211046]]　『VBAで同じ品名の合計数を別シートに貼り付けたい』（ネクサー）　ページの最後に飛ぶ

『VBAで同じ品名の合計数を別シートに貼り付けたい』（ネクサー）

エクセルの関数での処理をVBAに置き換えたいので、ご教示下さい。

B列の10行目から400行目が品名No.の入力行
C列にVLOOKUPで読み込まれた品名
D列に数量
が並んでいます。 B列の品名No.は被っているNo.もあります。
そして空白行もあります。

その内容を品名ごとの合計数を出し、別のシートにその品名No.と品名と数量を
貼り付けたいです。

エクセルの関数ならば、品名ごとにSUMIFし、ソートをかけて空白行を排除しその結果を貼り付けるという流れになるかと思いますが、それをVBAで処理をしたいのです。

よろしくお願いします。

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

 こんばんわ。

 >エクセルの関数ならば、品名ごとにSUMIFし、ソートをかけて空白行を排除し
 >その結果を貼り付けるという流れになるかと思いますが

 ならその手順をマクロ記録すれば良いだけでは？

（sy） 2017/02/24(金) 22:05

 ピボットや統合を使ったスマートなコードは、早晩、皆さんからアップされると思いますので
 ゴリゴリの力技コードを。

 元シートが "Sheet1" 、転記シートが "Sheet2"。　実際の名前に変更してください（★印）

 なお、転記先は　転記シートの A2 から。
 転記シートの A1:C1 に、あらかじめタイトルが設定されているという前提。

 Sub Sample()
    Dim v As Variant
    Dim dic As Object
    Dim c As Range
    Dim x As Long

    Set dic = CreateObject("Scripting.Dictionary")

    With Sheets("Sheet1")   '★元シート
        With .Range("B10", .Range("B" & Rows.Count).End(xlUp))
            ReDim v(1 To .Rows.Count, 1 To 3)
            For Each c In .Cells
                If c.Value <> "" Then
                    If Not dic.exists(c.Value) Then dic(c.Value) = dic.Count + 1
                    x = dic(c.Value)
                    v(x, 1) = c.Value
                    v(x, 2) = c.Offset(, 1).Value
                    v(x, 3) = v(x, 3) + c.Offset(, 2).Value
                End If
            Next
        End With
    End With

    With Sheets("Sheet2")   '★転記シート
        .Range("A1", .UsedRange).Offset(1).ClearContents
        .Range("A2").Resize(UBound(v, 1), UBound(v, 2)).Value = v
        .Select
    End With

 End Sub

（ β） 2017/02/24(金) 22:23

お返事ありがとうございます！
申しわけないです。
とんでもなくこちらの条件が間違っておりました。
※が訂正部分です。

　　B列の10行目から400行目が品名No.の入力行
　　C列にVLOOKUPで読み込まれた品名
　※D列に数量 →　型番でした
　※E列に数量　でした。
　　が並んでいます。 B列の品名No.は被っているNo.もあります。
　　そして空白行もあります。
。

その内容を品名ごとの合計数を出し、※別のシートのＣ列に品名・Ｄ列に品名・Ｅ列に型番・Ｆ列に数量を貼り付けたいです。

せっかくコードまでかいてくださったのに申し訳ございません。

（ネクサー） 2017/02/25(土) 01:04

 改訂要件を反映したコードをアップしようとしたら、その改訂要件（転記列）を、またまた変更してたんですか！！

 しかも C列に品名、D列にも品名？？？

 これに従ってコードを書き直しても、その時には、さらっと（なんのリマインドもなく）　C列に品名No なんて書き直されているかもしれない。

 幸い（？）転記は、最初のものと同じく連続した列になったようですから（こっそり書き直し前は飛び飛びでしたよね）
 すでにアップしたコードをじ～っと見つめて理解する努力をすれば、どこをどう直したらいいか見えてくると思うんですがね。

 ですから、こちらからの改訂コードのアップは控えます。

 もし、できないのであれば、syさんがアドバイスされているように、自分がわかる方法で手作業でやってみる。
 それをマクロ記録して、ブラッシュアップするというのが、今のネクサ―さんにとって、最も有益な方法だと思います。

（ β） 2017/02/25(土) 01:39

βさん　　大変失礼しました！
おっしゃる通りです。
まだ間に合うと勝手に思い込んでしまいました。
せっかく時間をさいてくださっていたのに申しわけございません。
ｓｙさんもβさんもお力お貸しくださってありがとうございました。
（ネクサー） 2017/02/25(土) 01:49

横から失礼します。
品名が同じでも型番の異なるものがありますよね。
その場合、型番はどう扱う(表示する）のですか？
検討されているのですか？
　
「ピボットテーブル」を使う気はありませんか？
Excelが準備した、こうした集計のための道具なんですけど。
一度作ってしまえば、あとからデータが増えても、対象データ項目を追加するだけです。
場合によっては、その部分も自動化できますが。

（γ） 2017/02/25(土) 02:30

＞まだ間に合うと勝手に思い込んでしまいました。
何に間に合うんでしょうか。
ご自分がコードを作成するのを、回答者は手助けするだけですから、
間に合う？かどうかは貴方次第じゃないですか？

（γ） 2017/02/25(土) 02:34

γさんコメントありがとうございます。
ピボットテーブルは使った事が無かったので、早速試してみます。

間に合うか、とは本当に勝手な言葉でした。
まともな情報も出さずに、しかもアップ後に間違いを勝手に訂正し、手助けして下さる方の時間を無駄にしてしまいました。
申し訳ありませんでした。
（ネクサー） 2017/02/25(土) 03:04

 眠かったので、つい、イラっとして　大人げないトーンのレスをしてしまいました。
 反省（ペコリ）

 私が言いたかったのは２点。

 １．要件としては列が増えていて、サマリーする列も変更になっているわけですが、集約キーはB列のまま、
 　　また転記先も連続したところに、元のレイアウトと同じ形で落とし込むわけですから、アップ済みにコードを
 　　よ～く見て、参考書などで配列というものを調べれば、おそらく自助努力で対応ができたのでは？
 　　そうしないと、もったいないですよ　ということ。

 ２．でも、もし、ＶＢＡに関して、まだ深くかかわっていない段階だとしたら、私がアップしたコードを使うより
 　　syさんも指摘しておられるように、まず、手作業ならどんな手順になるだろうということを考える。

 　　・元シートの B10:D400を別シートのC列にコピペ
 　　・そのデータを並び替え（空白を下に追いやるため）
 　　・その領域全体をC列だけで重複の削除機能で一意のリストにする。
 　　・F列に SUMIF関数を埋め込む

 　　で、この操作をマクロ記録してみる。
 　　そこで出来上がったコードを、固定領域の変数化とか、無駄なSelectコードをブラッシュアップして仕上げる。

 　　こういうアプローチが（いやみではなく）現在のネクサ―さんにとって、もっとも有効かつ有益な方法ではないだろうか。

 そういうことでした。いずれにしても、大人げない対応については、ごめんなさいです。

 ★私がアップしたコードでいえば

 ReDim v(1 To .Rows.Count, 1 To 3)  これを　ReDim v(1 To .Rows.Count, 1 To 4)

 v(x, 3) = v(x, 3) + c.Offset(, 2).Value これを

 v(x, 3) = c.Offset(, 2).Value
 v(x, 4) = v(x, 4) + c.Offset(, 3).Value　　この２行に。

 で、.Range("A2").Resize(UBound(v, 1), UBound(v, 2)).Value = v　これを

 .Range("C2").Resize(UBound(v, 1), UBound(v, 2)).Value = v  に変更すればＯＫだと思います。

（ β） 2017/02/25(土) 11:36

コメント返信：

[ 一覧(最新更新順) ]

[[20170224211046]] 『VBAで同じ品名の合計数を別シートに貼り付けたい』（ネクサー） ページの最後に飛ぶ

[[20170224211046]]　『VBAで同じ品名の合計数を別シートに貼り付けたい』（ネクサー）　ページの最後に飛ぶ