[[20190103040926]]　『項目ごとの集計について』（VBA勉強中）　ページの最後に飛ぶ

『項目ごとの集計について』（VBA勉強中）

VBAを使用しての集計方法について、
下記の様なA列「注文日」、B列「品名」、C列「発送日」リストがあります。
これを集計結果にあるような集計をしたいのですが、どの様な方法がありますでしょうか？
ピボットテーブルでは出来るのですが、VBAを使用して作業を簡略化させたいと考えております。
ご教授を宜しくお願いします。

     A列　　　　　B列　　　　　 C列
　　注文日　　　 品名　　　　  発送日
2018/1/1 10:00  みかん　　2018/1/5 10:00   
2018/1/2 10:00	リンゴ    2018/1/5 10:00
2018/1/3 10:00	バナナ
2018/1/4 10:00	みかん    2018/1/5 10:00
2018/2/1 10:00  みかん
2018/2/2 10:00	リンゴ    2018/2/5 10:00
2018/2/3 10:00	バナナ    2018/2/5 10:00
2018/2/4 10:00	みかん    2018/2/5 10:00

＜集計結果＞

 A列        B列　　　 C列　　　　D列         E列
 注文月　　 品名　　注文回数　 発送回数    発送率
 2018/1　  みかん　　  2　　　　　2	　　100%
 2018/1　　リンゴ　　  1 　　　　 1　　　　 100%
 2018/1　　バナナ　　  1　　　　  0　　　　　 0%
 2018/2　　みかん　　  2　　　　　1          50%
 2018/2　　リンゴ　　  1 　　　　 1         100%
 2018/2　　バナナ　　  1　　　　  0           0%

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

こんな感じでどうでしょうか

１）今あるピボットテーブルをコピー
２）データソースを新しいデータ範囲に更新

（マナ） 2019/01/03(木) 08:34

↑毎回ピボットテーブルを最初から作る必要がないのでは
という意味です。

（マナ） 2019/01/03(木) 08:45

こんな感じでも

１）D列を作業列として、注文月を計算
２）フィルタオプションで、注文月と品名を転記
３）countifsで、注文回数と発注回数を計算
４）発送率を計算
６）作業列を削除

（マナ） 2019/01/03(木) 09:07

ご参考。同じ方なんでしょうか？

「項目ごとの集計方法について」
https://www.moug.net/faq/viewtopic.php?t=77802
「配列を使って合計の出し方について」
https://www.moug.net/faq/viewtopic.php?t=77804

（γ） 2019/01/03(木) 10:16

配列の勉強が目的でしたか。
そういうことであれば、ここまでとします。

（マナ） 2019/01/03(木) 11:12

マナさんの書かれた　2019/01/03(木) 08:34　の発言が最適だと思います。

（γ） 2019/01/03(木) 11:19

マナさん

回答ありがとうございます。
countifs関数というのは使ったことがありませんので、
使用方法を調べて試してみます。

情報ありがとうございました。

（VBA勉強中） 2019/01/03(木) 17:44

mougと同じdictionaryを使った例です。

 Option Explicit

 Sub test()
    Dim dic As Object
    Dim w()
    Dim i As Long
    Dim 注文月  As String
    Dim 品名 As String
    Dim k As String
    Dim n As Long

    Set dic = CreateObject("Scripting.Dictionary")

    With Sheets("sheet1").Range("A1").CurrentRegion
        ReDim w(1 To .Rows.Count, 1 To 5)

        For i = 2 To .Rows.Count
            注文月 = Format(.Range("A" & i).Value, "yyyy/m")
            品名 = .Range("B" & i).Value
            k = 注文月 & 品名
            If Not dic.exists(k) Then
                dic(k) = dic.Count + 1
                n = dic(k)
                w(n, 1) = 注文月
                w(n, 2) = 品名
            End If
            n = dic(k)
            w(n, 3) = w(n, 3) + 1
            If .Range("C" & i).Value <> "" Then
                w(n, 4) = w(n, 4) + 1
            End If
            w(n, 5) = Format(w(n, 4) / w(n, 3), "0%")
        Next
    End With

    With Sheets("sheet2")
        .UsedRange.ClearContents
        .Range("A1").Resize(, 5).Value = [{"注文月","品名","注文回数","発送回数","発送率"}]
        .Range("A2").Resize(dic.Count, 5).Value = w
    End With

 End Sub

（マナ） 2019/01/03(木) 21:07

データタブにある統合機能で集計する例です。

 Sub test2()
    Dim rngS As Range
    Dim rngD As Range

    Set rngS = Sheets("sheet1").Cells(1).CurrentRegion
    rngS.Columns(1).Insert
    Set rngS = rngS.Columns(0).CurrentRegion
    rngS.Columns(1).FormulaR1C1 = "=TEXT(rc[1],""yyyy/m"")&char(9)&rc[2]"

    Set rngD = Sheets("sheet2").Cells(1)
    rngD.CurrentRegion.ClearContents

    rngD.Consolidate rngS.Address(, , xlR1C1, True), xlCount, True, True

    With rngD.CurrentRegion.Resize(, 5)
        .NumberFormatLocal = "G/標準"
        .Columns(5).FormulaR1C1 = "=rc[-1]/rc[-2]"
        .Columns(5).NumberFormatLocal = "0%"
        Application.DisplayAlerts = False
        .Columns(1).TextToColumns DataType:=xlDelimited, Tab:=True, Other:=False
        Application.DisplayAlerts = True

        .Rows(1).Value = [{"注文月","品名","注文回数","発送回数","発送率"}]
        .Value = .Value
   End With

    rngS.Columns(1).Delete xlShiftToLeft

 End Sub

（マナ） 2019/01/03(木) 21:40

マナさん

詳細なコードまで記載していただきありがとうございます。
希望通りの答えが出る事を確認しました。

記載いただいたコードを元に応用して、いろいろと試してみます。
ありがとうございました。
（VBA勉強中） 2019/01/04(金) 08:29

Sub main()'ご参考
'Sheet1からSheet2に集計

    Dim c As Range
    With Sheets("Sheet2")
        .Cells.ClearContents
        Sheets("Sheet1").Cells.Copy .Range("A1")
        For Each c In .Range("A2:A" & Rows.Count).SpecialCells(2)
            c.Value = Format(c.Value, "yyyy/m")
            c.Offset(, 2).Value = Format(c.Offset(, 2).Value, "yyyy/m")
        Next c
        For Each c In .Range("A2:A" & Rows.Count).SpecialCells(2)
            c.Offset(, 3).Value = WorksheetFunction.CountIfs(.Range("A:A"), c.Value, .Range("B:B"), c.Offset(, 1).Value)
            c.Offset(, 4).Value = c.Offset(, 3).Value - WorksheetFunction.CountIfs(.Range("A:A"), c.Value, .Range("B:B"), c.Offset(, 1).Value, .Range("C:C"), "")
            c.Offset(, 5).Value = 100 * c.Offset(, 4).Value / c.Offset(, 3).Value & "%"
        Next c
        .Range("C:C").Delete
        .Columns("A:E").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes
        .Range("A1:E1").Value = Array("注文月", "品名", "注文回数", "発送回数", "発送率")
    End With
End Sub
（mm） 2019/01/04(金) 14:49

mmさん

Array関数を使った方法ですね。
いろいろな集計方法と、シートへの出力方法があり勉強になります。
ありがとうございました。
（VBA勉強中） 2019/01/06(日) 03:24

 別案

 Sub test()
     Dim cn As Object, rs As Object, i As Long
     Set cn = CreateObject("ADODB.Connection")
     Set rs = CreateObject("ADODB.Recordset")
     With cn
         .Provider = "Microsoft.Ace.OLEDB.12.0"
         .Properties("Extended Properties") = "Excel 12.0;HDR=Yes;IMEX=1;"
         .Open ThisWorkbook.FullName
     End With
     rs.Open "Select Format(注文日,'yyyy/m') As 注文月, 品名, Count(*) As 注文回数, " & _
             "Sum(IIf(発送日 Is Null, 0, 1)) As 発送回数, (Sum(IIf(発送日 Is Null, 0, 1)) / Count(*)) " & _
            "As 発送率 From `Sheet1$` Group By Format(注文日,'yyyy/m'), 品名 Order By Format(注文日,'yyyy/m')", cn, 3
     For i = 0 To rs.Fields.Count - 1
         Cells(1, i + 8).Value = rs.Fields(i).Name
     Next
     [h2].CopyFromRecordset rs
     [h2].Resize(rs.RecordCount).Columns(5).NumberFormat = "0%"
     Set rs = Nothing: Set cn = Nothing
 End Sub
（seiya） 2019/01/06(日) 20:23

コメント返信：

[ 一覧(最新更新順) ]

[[20190103040926]] 『項目ごとの集計について』（VBA勉強中） ページの最後に飛ぶ

[[20190103040926]]　『項目ごとの集計について』（VBA勉強中）　ページの最後に飛ぶ