Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 8.1 Pro : Excel 2007)
集計項目をもう1つ追加したい
投稿日時: 17/07/28 09:05:14
投稿者: FILETUBE

おはようございます。
先日はありがとうございました。
  
再度、教えてください。
  
a.xlsmのセル(1, 2)に条件を入力し抽出ボタンをクリックし
data.xlsxから条件の値と一致する行を取得し4行目から
コピー貼り付けするプログラムを作成しました。
これを品番で数量を集計するようにしましたが
集計項目をもう1つ追加し品番、連番で集計するようにしたいのです。
  
  

data.xlsx
番号 品番  連番 数量
A 1 5 10
A 1 6 10
A 2 5 10
A 2 5 10
A 2 6 10
A 3 6 10
B 1 5 10
   
 a.xlsmに条件番号 Aと入力
  
品番 連番 数量
 1 5 10
 1 6 10
 2 5 20
 2 6 10
 3 6 10
とデータを取得しセットしたいのです。
 
With thisws
    For r = 4 To c
       If WorksheetFunction.CountIf(.Range("D:D"), .Cells(r, "A").Value) = 0 Then
          cnt = cnt + 1
          .Cells(cnt, "D").Value = .Cells(r, "A").Value
          .Cells(cnt, "E").Value = WorksheetFunction.SumIf(.Range("A:A"), .Cells(r, "A").Value, .Range("B:B"))
       End If
    Next r
 End With
 
の部分をどのように修正するとよいのか、教えて頂けないでしょうか?
どうぞよろしくお願いします。

回答
投稿日時: 17/07/28 09:22:07
投稿者: めんたん

Sumif関数をSumifs関数に変更してみてはどうでしょうか?
 
WorksheetFunction.SumIf(.Range("A:A"), .Cells(r, "A").Value, .Range("B:B"))
 

 
WorksheetFunction.SumIfs(sumifs関数の数式に合わせて書き換え)

回答
投稿日時: 17/07/28 09:29:07
投稿者: めんたん

そもそもピボットテーブルで処理してはいけないですか?

投稿日時: 17/07/28 10:16:04
投稿者: FILETUBE

回答ありがとうございます。
下記のようにSumIfsで修正してみましたが
 
.Cells(cnt, "E").Value = WorksheetFunction.SumIfs(.Range("C:C"), .Range("A:A"), .Cells(r, "A").Value, .Range("B:B"), .Cells(r, "B").Value)
 
結果が変わりません。
どこか間違っているのでしょうか?

投稿日時: 17/08/17 11:13:39
投稿者: FILETUBE

こんにちは。
何とか解決したいので再度投稿させて頂きます。
 
 
まずdata.xlsx があります。
番号 品番  連番 数量
 A 1 5 10
 A 1 6 10
 A 2 5 10
 A 2 5 10
 A 2 6 10
 A 3 6 10
 B 1 5 10
     
別のa.xlsmのB1セルに番号 Aと入力し,
data.xlsxから条件の番号と等しいデータ品番、連番、数量をA,B,C列にセットし
と同時に品番、連番で集計しE,F,Gにセットしたいのです。
  
A B C D E F 集計する
品番 連番 数量 品番 連番 数量
  1 5 10 1 5 10
  1 6 10 1 6 10
  2 5 10 2 5 20
  2 5 10 2 6 10
  2 6 10 3 6 10
  3 6 10
こういう結果にしたいのです。
 
 
        Dim thisws As Worksheet
        Set thisws = ThisWorkbook.Worksheets(1)
        '***
        Dim wb As Workbook
        Set wb = Workbooks.Open("C:\data.xlsx", True)
 
        Dim wks As Worksheet
        Set wks = wb.Worksheets(1)
         
        Dim rng As Range
        Set rng = wks.Cells(wks.Rows.Count, 2).End(xlUp)
        Dim r As Long
        Dim c As Long
       
        c = 3
        '*********************************************************************
        For r = 1 To rng.Row Step 1
             '番号で比較
             If wks.Cells(r, 1) = thisws.Cells(1, 2) Then
                c = c + 1
                thisws.Cells(c, 1) = wks.Cells(r, 2)
                thisws.Cells(c, 2) = wks.Cells(r, 3)
                thisws.Cells(c, 3) = wks.Cells(r, 4)
             End If
        Next
        '*********************************************************************
        Dim cnt As Long
        cnt = 3
        With thisws
           For r = 4 To c
              If WorksheetFunction.CountIf(.Range("E:E"), .Cells(r, "A").Value) = 0 Then
                 cnt = cnt + 1
                 .Cells(cnt, "E").Value = .Cells(r, "A").Value
                 .Cells(cnt, "F").Value = .Cells(r, "B").Value
                 .Cells(cnt, "G").Value = WorksheetFunction.SumIf(.Range("A:A"), .Cells(r, "A").Value, .Range("C:C"))
              End If
           Next r
        End With
         
        wb.Close True
       
    'オブジェクトの終了
    Set wb = Nothing
    Set wks = Nothing: Set thisws = Nothing
 
 
とコーディンしましたが
A B C D E F 集計する
品番 連番 数量 品番 連番 数量
  1 5 10 1 5 20
  1 6 10 2 5 30
  2 5 10 3 6 10
  2 5 10
  2 6 10
  3 6 10
 
という結果になってしまいます。
 品番 連番で数量を集計したいのですが
品番だけで集計されてしまいます。
 
今一度、複数項目での集計方法を教えて頂けないでしょうか?
どうぞ宜しくお願いします。
 

回答
投稿日時: 17/08/17 17:53:29
投稿者: simple

すでにコメントがありますが、ピボットテーブルを使うのがいいと思います。
 
こういう時のためにExcelが用意している機能なんですから。
こうしたコードをゴリゴリ書いたとしても、項目が増えたらさらにゴリゴリしないといけない。
それよりピボットのほうが汎用性は高いです。
 
もちろん可能は可能でしょう。
品番&タブ記号&連番を キーとして、
数量を アイテム
とした辞書(dictionary)にデータを読み込み加算していって、
最後にキーを二つにばらして、表に書き込む、といった方針でできるでしょうけど、
余りイカしていない。(昭和初期の言い方かも)
 
それよりも、ピボットテーブルの活用をお薦めします。

回答
投稿日時: 17/08/17 18:48:21
投稿者: simple

辞書を使ったコード例を書いておきます。参考になりますか。
同一シート内で集計、結果書込という単純な例で書いておきます。
 

Sub test()
    Dim dic As Object
    Dim mat()
    Dim v1, v2, v3
    Dim key
    Dim k As Long
    
    ' 辞書に数量を加算する。 キーは品番+タブ+連番
    Set dic = CreateObject("Scripting.Dictionary")
    
    For k = 1 To Range("A1").End(xlDown).Row
        If Cells(k, 1).Value = "A" Then
            v1 = Cells(k, 2).Value  '品番
            v2 = Cells(k, 3).Value  '連番
            v3 = Cells(k, 4).Value  '数量
            dic(v1 & vbTab & v2) = dic(v1 & vbTab & v2) + v3
        End If
    Next
    
    ' キーを元に分解して、結果を配列に書換え
    ReDim mat(1 To dic.Count, 1 To 3)
    k = 0
    For Each key In dic
        k = k + 1
        mat(k, 1) = Split(key, vbTab)(0)  '品番
        mat(k, 2) = Split(key, vbTab)(1)  '連番
        mat(k, 3) = dic(key)              '合計数量
    Next
    
    ' シートに書き込み
    Range("K1").Resize(dic.Count, 3) = mat
End Sub

投稿日時: 17/08/17 20:22:09
投稿者: FILETUBE

simpleさん、回答ありがとうございます。
辞書という機能があるのですね。
すごいですね、このようなコードで品番、連番で集計できるのですね。
今は検証できないので、明日検証してみたいと思います。
 
ちなみにピボットを使うとなると、どのような感じになるのでしょうか。
マクロの記録でコードを取ってみるとよいのでしょうか。
 
 

回答
投稿日時: 17/08/17 20:41:22
投稿者: simple

>ちなみにピボットを使うとなると、どのような感じになるのでしょうか。
どのような表が必要になるかという話になるでしょうね。
 

番号         A            
                          
品番         連番         合計 / 数量
1            5            10
1            6            10
2            5            20
2            6            10
3            6            10
総計                      60
こんな表は簡単に作成できますね。
手作業でいいんじゃないですか?
あとは、マクロなり手作業でデータ範囲を更新すればよいだけですから。

投稿日時: 17/08/17 22:31:26
投稿者: FILETUBE

回答ありがとうございます。
確かにピボットの表はそのような感じになると思います。
 
ただ番号を次々と入力して集計した結果を表示させたいので
自動化、プログラム化したいのです。
 
番号Aを入力後、次は番号B、Cみたいにですが。
ピボットになるとかなりプログラムは複雑になるでしょうか。
 
 

回答
投稿日時: 17/08/18 01:35:33
投稿者: simple

手作業で一度ピボットを作ってしまえば、
1.データ領域の指定
2. レポートフィルタの指定
3. 結果のコピーペイスト
の部分をマクロにするだけかと思う。
 
その都度、ピボットを作成されたいようですが、
>ピボットになるとかなりプログラムは複雑になるでしょうか。
ご自分でマクロ記録をお取り下さい。
私がやるとしても、マクロ記録です。
そんなもの覚えている人なんかいませんよ。

投稿日時: 17/08/18 16:28:54
投稿者: FILETUBE

 simpleさん、回答ありがとうございました。
すごいですね、Dictionaryは初めて使いました。
これで集計ができるのですね。
 
ピボットもあまり使ったことがなく、一度マクロをとってみます。
 

投稿日時: 17/09/11 11:32:20
投稿者: FILETUBE

simpleさん、大変丁寧にありがとうございました。
今一度、お聞きしたい事があるのですが、
 
Sub test()
    Dim dic As Object
    Dim mat()
    Dim v1, v2, v3
    Dim key
    Dim k As Long
     
    ' 辞書に数量を加算する。 キーは品番+タブ+連番
    Set dic = CreateObject("Scripting.Dictionary")
     
    For k = 1 To Range("A1").End(xlDown).Row
        If Cells(k, 1).Value = "A" Then
            v1 = Cells(k, 2).Value '品番
            v2 = Cells(k, 3).Value '連番
            v3 = Cells(k, 4).Value '数量
            dic(v1 & vbTab & v2) = dic(v1 & vbTab & v2) + v3
        End If
    Next
     
    ' キーを元に分解して、結果を配列に書換え
    ReDim mat(1 To dic.Count, 1 To 3)
    k = 0
    For Each key In dic
        k = k + 1
        mat(k, 1) = Split(key, vbTab)(0) '品番
        mat(k, 2) = Split(key, vbTab)(1) '連番
        mat(k, 3) = dic(key) '合計数量
    Next
     
    ' シートに書き込み
    Range("K1").Resize(dic.Count, 3) = mat
End Sub
 
のコードを教えて頂きましたが、集計項目の追加はわかるのですが
数量の集計に加えて、金額の集計もしたいのですが
これに金額の集計の追加は可能なのでしょうか?
 
大変申し訳ありません、どうぞよろしくお願いします。

投稿日時: 17/09/11 15:05:25
投稿者: FILETUBE

 こんにちは。
参考になりそうなサイトを見つけたのですが。
 
https://oshiete.goo.ne.jp/qa/4955154.html
 
Sub try_3()
  Dim dic As Object 'Dictionary用
  Dim s  As String 'キー文字列結合用
  Dim key As Variant 'key列用
  Dim ary As Variant '集計列用
  Dim c  As Variant '配列Loop用
  Dim v  As Variant '元データ格納用配列
  Dim w  As Variant 'データ集計・書き出し用配列
  Dim n  As Long  '配列の要素index用
  Dim i  As Long
  Dim j  As Long
 
  key = Array(1, 3, 4, 6) 'key列
  ary = Array(2, 5)    '集計列
 
  With ThisWorkbook
    v = .Sheets("sheet1").Range("A1").CurrentRegion '.Resize(, 6)
    ReDim w(1 To UBound(v, 1), 1 To UBound(v, 2))
 
    Set dic = CreateObject("Scripting.Dictionary")
    n = 0
    For i = 1 To UBound(v)
      'キー文字列 s として結合
      s = ""
      For Each c In key
        s = s & v(i, c) & vbTab
      Next
      If dic.Exists(s) Then
        '既登録ならindexを取得
        j = dic(s)
      Else
        '未登録ならindexを追加
        n = n + 1
        dic(s) = n
        j = n
        '未登録なら書き出し用配列 w にkey列をセット
        For Each c In key
          w(j, c) = v(i, c)
        Next
      End If
      '書き出し用配列 w に集計列を加算
      For Each c In ary
        w(j, c) = w(j, c) + v(i, c)
      Next
    Next
 
    With .Sheets("sheet2")
      .UsedRange.ClearContents
      .Range("A1").Resize(n, UBound(w, 2)).Value = w
    End With
  End With
 
  Set dic = Nothing
End Sub
 
今回作ったVBAをどのように訂正するとよいのか
試し試し行っているのですが。
 
わかる方おられましたら、教えていただけないでしょうか。
 
宜しくお願いします。
 

回答
投稿日時: 17/09/11 20:06:24
投稿者: simple

>今回作ったVBAをどのように訂正するとよいのか
私は、訂正を必要とするような間違ったコードは提示していません。
 
正直申し上げて、gooで提示されたコードを活用できないなら、
dictionaryの使用は当面やめて、ピボットテーブルを使うべきだと思います。
 
まさにこういう時のためにExcelが用意している機能なんですから、
これを使わない手はありません。
なお、既に指摘済みですが、
ピボットを一度作成してしまえば、データの更新だけマクロにすればよいだけです。

投稿日時: 17/09/11 21:44:55
投稿者: FILETUBE

回答ありがとうございます。
すいません、dictionaryでだいぶ作ったもので。
ピボットを作っておけば、あとはデータの更新だけマクロでと
ありましたが、確かにそうかもしれません。

トピックに返信