• 締切済み

VBAに関する質問です

現在、以下の記述で項目の名称が一致した場合、数字の加算集計を行って名称と加算結果を別シートに表示させるマクロを使用しています。 このマクロに記述を加えて、『部署名別に項目名が一致した場合、数字の加算を行って部署名、項目名、加算集計結果を別シートに並べて表示させる』というマクロを作る場合、どのように記述すれば宜しいでしょうか? ご回答宜しくお願いします。 Sub sample() Dim i As Long, db, wk Set db = CreateObject("Scripting.Dictionary") For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row wk = Cells(i, "A") db(wk) = db(wk) + Cells(i, "B") Next With Sheets("sheet2") wk = db.keys For i = 0 To UBound(wk) .Cells(i + 1, "A") = wk(i) .Cells(i + 1, "B") = db(wk(i)) Next End With Set db = Nothing End Sub

みんなの回答

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.2

#1です。 Excel(エクセル) VBA入門:Dictionaryオブジェクトを利用する http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_dictionary.html こちらのサイトにある <2つの条件で合計する> と言うものを 希望されているのでしょうか? ⇒B列とC列を逆として考えれば良いのではないかな? 提示されているコードを作成されているなら、 あとちょっとで出来そうに思います。

tkntks2005
質問者

補足

お返事ありがとうございます。 貼っていただいたサイトを拝見させていただきました。 自分が希望しているものに非常に近い形だと思います。

全文を見る
すると、全ての回答が全文表示されます。
  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.1

>『部署名別に項目名が一致した場合、数字の加算を行って部署名、 >項目名、加算集計結果を別シートに並べて表示させる』 提示されているコードからこれら項目がどこにあるかはわかりませんよね? まずどんなデータがどのようにシート内のセルに入っているのか、 その辺の情報をあげないと。。。 ⇒何となくどこかでか見たようなコードなんですけどね。

tkntks2005
質問者

補足

大変失礼しました。 A欄に品名があり、B欄に数字があります。 質問にて記述させていただいた記述では、A欄の名称が一致した場合、一致した名称の行にあるB欄にある数字の加算集計を行うものです。 この記述に手を加え、C欄にある部署名別にA欄の名称が一致した場合、B欄の加算集計を行いたいと思っています。

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • VBAについて質問です

    添付されている画像のように表があり、部署別に品名が一致した場合、品名毎の数量を加算集計して『部署名』『品名』『型番』『集計結果の数量』をSheet2へ表示させたい場合、どのような記述を行えばよろしいでしょうか? ご回答宜しくお願いします。

  • VBAでの質問

    お世話になります。 下記の記述で、「←」の矢印の記述で、 Cells.(5,2)がブランクでなければ、 「→」から進めたいのですが、 どの様に記述すれば宜しいでしょうか ご教示お願いします。 Sub 表記入() Dim Data As Range Dim i As Integer Dim j As Integer Dim k As Integer Set Data = Sheets("集計").Range("A2").CurrentRegion j = 16 k = 0 With Sheets("表") For i = 3 To Data.Rows.Count If Data.Cells(i, 51) <> "" Then .Cells(5, 2) = Data.Cells(i, 3)  ← .Cells(5, 7) = Data.Cells(i, 4) → .Cells(j, 2) = Data.Cells(i, 10) .Cells(j, 6) = Data.Cells(i, 11) & Data.Cells(i, 12) .Cells(j, 14) = Data.Cells(i, 51) Else End If k = k + 1 If k = 10 Then j = j + 18 k = 0 Else j = j + 1 End If End If Next i End With End Sub

  • VBA 別シートからコピー貼付け(複数列)

    別シートからコピー貼付け(複数列)をしたいのですが,同一シートからのコピー貼付けはネットから以下のマクロでできました。 しかし,別シートsheet1からsheet2ヘコピーで修正しましたが,「アプリケーション定義またはオブジェクト定義のエラーです。」となります。どなたかご教授よろしくお願いします。 修正したマクロ Sub sampel() Dim i As Long For i = 2 To Range("E65536").End(xlUp).Row Step 2 Sheets("sheet2").Range(Cells(i + 1, 2), Cells(i + 1, 85)).Value = _ Sheets("sheet1").Range(Cells(i, 5), Cells(i, 88)).Value Next i End Sub 参考としたマクロ http://www.excel.studio-kazu.jp/kw/20041208152106.html Sub sampel() Dim i As Long For i = 2 To Range("E65536").End(xlUp).Row Step 2 Range(Cells(i + 1, 2), Cells(i + 1, 85)).Value = _ Range(Cells(i, 5), Cells(i, 88)).Value Next i End Sub

  • VBA:イベントの使い方

    ActiveXというのを使って、ある測定器から測定値をPC(エクセルシート)に取込んでいます(GPIB)。測定値は一行おきにエクセルに示されます。測定値を取り込んだ瞬間、作成したマクロによってそのときの時刻を隣の列に示したいのですがうまく表示できません。といいますかまずイベントが機能しません。どこが悪いのか教えてください。 Private Sub worksheet_change(ByVal target As Range) i = i + 1 Cells(4 + i, 1).Value = Now End Sub シート内に自動的に測定値が記述されるため、記述されることをイベントとして記述されたことで発生するマクロを記述したつもりです。

  • Excel VBAで他のワークブックからのコピぺの仕方について

    Excel VBAで開いている全てのワークブックから決められたセルの中身とそのシート名をそれぞれ決められた一つのワークブックにコピぺする マクロを作りたいのですが、どうやって作って良いのかが分かりません。 例えば、 Sub Mac() For i = 1 To 100 Workbooks("Book1.xls").Worksheets("sheet1").Range(Cells(2108, 2), Cells(3108, 2)).Cut Destination:=Workbooks("Book1.xls").Worksheets("sheet1").Cells(13, 2) End Sub みたいにすれば良いと思うのですが、開いている全てのファイルからのコピぺってどうやって記述するのでしょうか? 何卒よろしくお願い致します。

  • エクセルVBAの繰り返し処理の質問

    C列にある項目とG列にある項目を比較して、 一致し、H列にある数字が10以上ならば、B列にフラグ1を立てる という処理を行いたいんですが、 下記ぐらいまでしか作れず、うまくいきません・・・ Sub フラグを立てる処理() Dim i As Integer Dim j As Integer Dim k As Integer i = 1 j = 1 Do j = j + 1 Do i = i + 1 If Cells(j, 8) > 9 Then Cells(i - 1, 4) = 1 End If Loop Until Cells(i, 3) <> Cells(j, 7) Or Cells(i, 3) = "" Loop Until Cells(j, 7) = "" End Sub わかる方がいらっしゃいましたら、お願いします。

  • VBA 比較してリンク

    初めまして。VBA初心者です。 まずはこちらを見て下さい。   Sheet1                Sheet2             A     B    C   D        A     B    C   D 1 大区分 中区分 名称       20 大区分 中区分 名称 2  A     a    あ   1    21  A     a   あ   1 3            い  2    22            い   2 4            う   3    23            う   3 5            え  4    24            お   5 6            お  5    25        b    あ   1→6 7        b    あ  6    26            い   2→7 8            い  7    27            う    3→8 9            う   8    28            お   5→10 10            え  9    29  B     a    か   11 11            お  10   30            き   12 12  B    a    か  11    31            け   14 13            き  12    32            こ    15 14            く   13    33       b    か    11→16 15            け  14    34            き    12→17 16            こ   15    35           け    14→19 17       b    か   16    36           こ    15→20 18            き   17 19            く   18 20            け   19 21            こ   20 元々関数を使用していたのですが、数があまりに多くなってきたため、VBAで処理できればと初めて作ってみましたが、途中で行き詰った為ご教授お願いします。 Sheet1,2にそれぞれ表があり、Sheet1が元となります。(行は1000行以上になることもあります。) それで、Sheet2の名称をSheet1の名称と比べ同じ場合、Sheet1のD列をSheet2のD列にリンクさせたいのです。 一応、色々見ながら下記のように組んでみたのですが、矢印の左側のようになってしまいます。 これを、右側のような結果にしたいのですが、なんとなく間違ってる箇所は分かるものの、どのようにしていいか分かりません。 これをどのようにしたらよろしいでしょうか?若しくは、他にやり方があれば教えて頂きたいです。 分かりづらい説明で申し訳ないですが、よろしくお願い致します。 sub test()  Dim i As Integer,maxrow As Integer  maxrow = Sheet2.Range("C" : Rows.Count).End(xlup).Row    For i = 1 To maxrow - 19      If Sheet1.Cells (1+i,3)=Sheet2.Cells(19+i,3) Then        Sheet2.Cells(19+i,4)="=Sheet1" & Sheet1.Cells(1 + i,3).Offset(0,1).Address      Else        Sheet2.Cells(19+i,4)="=Sheet1" & Sheet1.Cells.Find(Sheet2.Cells(19+i,3)) _                        .Offset(0,1).Address      End if    Next i End sub

  • 【Excel VBA】データ貼り付けの開始位置について

    Excel2003を使用しています。 先日、こちらでアドバイスをいただきながら、下記のようなマクロを作りました。内容はあるセルの値と同じ名前のシートへデータをコピーするというものです。 Sheet1に貼り付け元のデータが表形式であり、必要なデータのみ該当のシートへコピーします。マクロ実行後は、別の新しいデータをSheet1へコピペして、またマクロを実行するのですが、その際、データの貼り付け開始位置を前回マクロを実行して貼り付けられたデータから2行空けたいのですが、可能でしょうか? ________________________________________________________________________________________________________________________________ Sub test3() Dim n As Long Dim i As Long Dim j As Long  Worksheets("Sheet1").Activate   For n = 4 To Cells(Rows.Count, 2).End(xlUp).Row    If Cells(n, 3).Value <> "" Then     With Worksheets(CStr(Cells(n, 3).Value))       i = .Cells(Rows.Count, 3).End(xlUp).Row + 1       Cells(n, 2).Copy .Cells(i, 2)       Cells(n, 7).Resize(, 2).Copy .Cells(i, 4)       Cells(n, 11).Copy .Cells(i, 3)     End With    End If    If Cells(n, 13).Value <> "" Then     With Worksheets(CStr(Cells(n, 13).Value))       j = .Cells(Rows.Count, 3).End(xlUp).Row + 1       Cells(n, 12).Copy .Cells(j, 2)       Cells(n, 17).Copy .Cells(j, 4)       Cells(n, 18).Copy .Cells(j, 6)       Cells(n, 11).Copy .Cells(j, 3)     End With    End If   Next n End Sub

  • マクロ 関数COUNTIFS 使用時の?

    いつも回答して頂きありがとうございます。 マクロの記述中にも関数の入力が必要な場合があると最近知った者です。 で、質問ですが、 集計用シートのC3・D3・E3・・・・に商品名が入力されている 集計用シートのB4・B5・B6・・・・に日付が連続して入力されている 履歴シートから1日単位で商品の動きを調査したいと思いますが マクロの記述中にCOUNTIFSを使う方法はあるのでしょうか? 商品名毎の繰り返し処理を記述しましたが、参照セルの移動方法が分かりません。御指導の程宜しくお願い致します。(マクロ記述の中にある??が分からない箇所です。) Sub 集計4() Dim retu As Long retu = 3 For retu = 3 To Cells(3, Columns.Count).End(xlToLeft).Column Worksheets("集計用").Cells(4, retu).Formula = "=COUNTIFS(データ元!B8:B60000,集計用!??,データ元!D8:D60000,集計用!??)" Next retu End Sub

  • エクセルVBAの質問です。

    次のようなマクロを作ったのですがエラーにはならないのですが、うまく働きません。 Else if の行が悪いと思うのですがどうなおせばいいのかわかりません。 どなたか教えてください、よろしくお願いします。 Sub 判定() Application.ScreenUpdating = False '処理中の表示をさせない lastrow = (Range("B4").End(xlDown).Row) 'B列の一番最後の行番号を代入 length(1) = Range("S2") For i = length(1) + 4 + 1 To lastrow If Cells(i - 1, 8) = "" And Cells(i - 1, 15) = "GC3" Or Cells(i - 1, 15) = "GC2" Then Cells(i, 8) = Cells(i, 2) * Cells(1, 5) + Cells(1, 7) ElseIf Cells(i - 1, 8) <> "" And Cells(i - 1, 15) = "DC3" Or Cells(i - 1, 15) = "DC2" Or Cells(i - 1, 15) = "DC1" Then Cells(i, 9) = Cells(i, 2) * Cells(1, 5) - Cells(1, 7) Else: Cells(i, 8) = Cells(i - 1, 8) End If     Next End Sub