[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『『重複データ複数条件の集計 その2』』(seitomo)
昨日、素晴らしいご回答をいただいた内容で、新たに追加したい項目が発生した為、再度質問させていただきます。
Sh1のA列に受付区分 B列に商品名 D列に店舗名 F列に個数
といった表があります。
(1行目は空白で項目目はなく、2行目からデータが入っています)
全ての項目の内容は、取込みデータで 毎回違います
Sh2の1行目は固定された項目が入っています
下記条件でSh2に集計結果をマクロを使って表示させたいです。
条件1:Sh1のA列が「受注」もしくは「予約」
条件2:Sh1のB列&D列の組み合わのもののF列の個数を合計する
条件3:条件1の範囲でSh1のB列&D列の組み合わのものの個数をSh2のE列に表示
《Sh1》
A B D F 1 2 受注 あ 新宿 5 3 失注 あ 大阪 2 4 受注 い 新宿 8 5 予約 う 名古屋 2 6 予約 あ 新宿 1 7 失注 い 福岡 2 8 受注 あ 大阪 5 ↓↓このように表示したいです 《Sh2》 A B C E 1 2 あ 新宿 6 2 3 あ 大阪 5 1 4 い 新宿 8 1 5 う 名古屋 2 1
よろしくお願いいたします。
< 使用 Excel:Excel2007、使用 OS:Windows7 >
Dim c As Range With Sheets("Sheet2") .Cells.ClearContents For Each c In Sheets("Sheet1").Range("A:A").SpecialCells(2) If c.Value = "受注" Or c.Value = "予約" Then .Range("A" & i + 2).Resize(, 3).Value = Array(c.Offset(, 1).Value, c.Offset(, 3).Value, c.Offset(, 5).Value) i = i + 1 End If Next c For Each c In .Range("A:A").SpecialCells(2) c.Offset(, 3).Value = WorksheetFunction.SumIfs(.Range("C:C"), .Range("A:A"), c.Value, .Range("B:B"), c.Offset(, 1).Value) c.Offset(, 5).Value = WorksheetFunction.CountIfs(.Range("A:A"), c.Value, .Range("B:B"), c.Offset(, 1).Value) Next c .Range("C:C").Delete .Range("A2:E" & Rows.Count).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlNo With .Sort .SortFields.Clear .SortFields.Add Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending .SetRange Range("A2:E" & Rows.Count) .Apply End With End With End Sub (mm) 2018/10/12(金) 14:55
.Range("C1:C" & AR.Count).Formula = "=SUMIFS('Sh1'!F1:F" & iMax & _ ",'Sh1'!A1:A" & iMax & ",""<>失注""," & _ "'Sh1'!B1:B" & iMax & ",A1," & _ "'Sh1'!D1:D" & iMax & ",B1)" .Range("E1:E" & AR.Count).Formula = "=COUNTIFS('Sh1'!A1:A" & iMax & ",""<>失注""," & _ "'Sh1'!B1:B" & iMax & ",A1," & _ "'Sh1'!D1:D" & iMax & ",B1)" (???) 2018/10/12(金) 14:58
早速ご教示いただき誠にありがとうございます。
無事解決に至りました。
この度挙げていただいた内容を熟考いたします。
重ね重ね御礼を申し上げます。
(seitomo) 2018/10/12(金) 15:05
Sub test() Dim AR As Object Dim vw As Variant Dim cw As String Dim i As Long Dim iMax As Long
Set AR = CreateObject("System.Collections.ArrayList") With Sheets("Sh1") iMax = .Cells(.Rows.Count, "A").End(xlUp).Row For i = 2 To iMax If .Cells(i, "A").Text <> "失注" Then cw = .Cells(i, "B").Text & "|" & .Cells(i, "D").Text If Not AR.Contains(cw) Then AR.Add cw End If End If Next i End With AR.Sort With Sheets("Sh2") .Cells.ClearContents For i = 0 To AR.Count - 1 vw = Split(AR(i), "|") .Cells(i + 2, "A").Value = vw(0) .Cells(i + 2, "B").Value = vw(1) Next i .Range("C2:C" & AR.Count + 1).Formula = "=SUMIFS('Sh1'!F2:F" & iMax & _ ",'Sh1'!A2:A" & iMax & ",""<>失注""," & _ "'Sh1'!B2:B" & iMax & ",A2," & _ "'Sh1'!D2:D" & iMax & ",B2)" .Range("E2:E" & AR.Count + 1).Formula = "=COUNTIFS('Sh1'!A2:A" & iMax & ",""<>失注""," & _ "'Sh1'!B2:B" & iMax & ",A2," & _ "'Sh1'!D2:D" & iMax & ",B2)" End With End Sub (???) 2018/10/12(金) 15:06
別案
Sub test() Dim cn As Object, rs As Object 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=No" .Open ThisWorkbook.FullName End With rs.Open "Select F2, F4, Sum(F6), Count(*) From `Sh1$A2:F50000` " & _ "Where F1 In ('受注', '予約') Group By F2, F4", cn Sheets("sh2").Range("a2").CopyFromRecordset rs Set cn = Nothing: Set rs = Nothing End Sub (seiya) 2018/10/12(金) 18:31 参照列の修正 2018/10/13 20:45
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.