Results of 1 - 1 of about 13159 for 日付 (0.003 sec.)
- [[20230508121022]]
- #score: 2423
- @digest: dc13d6d78166208ed5bde3f443d2e432
- @id: 94190
- @mdate: 2023-05-14T05:49:54Z
- @size: 109570
- @type: text/plain
- #keywords: shopname (395466), shopdata (383463), 計タ (301675), 店客 (215237), 客数 (214496), 別客 (186352), 宿店 (160606), 率: (156777), property (144255), リ使 (141899), 均( (127273), 別売 (115236), customer (112505), 来店 (109767), 店| (106698), 用率 (102396), 計( (98178), 全店 (84561), 日別 (82743), 店舗 (67311), 店別 (56890), 計. (47200), クラ (46772), 舗名 (39486), ラス (35092), 売上 (30874), 平均 (27988), モリ (27885), public (26916), 集計 (25242), dictionary (22804), 2023 (21997)
- 『[ Let, Get ]Class で集計処理』（あみな）
紫陽花(アジサイ)のお花が、とっても綺麗な時期ですねェ。 お世話になっております。 「 Excel VBA 」の初心者( ぴょぴょ ) です。 宜しくお願いします。 (o_ _)o 本題です。 （山川海湖）さんの影響を受けて、クラスの勉強を始めました。 しかしながら...即!! 、挫折しました。・ﾟ・ショボ━(´pωq｀)ーン・ﾟ・ [ A:D ]範囲に、元表があります。 |[A] |[B] |[C] |[D] |[E]|[F] |[G] |[H] |[I]|[J] |[K] |[L] [1] |日付 |店舗名|来店客数|日別売上| |日付 |来店客数(全店)|日別売上(全店)| |店舗名|来店客数(平均)|購入単価(平均) [2] |2023/5/1|渋谷店| 56| 250,000| |2023/5/1| | | |渋谷店| | [3] |2023/5/1|新宿店| 63| 250,000| |2023/5/2| | | |新宿店| | [4] |2023/5/1|原宿店| 59| 250,000| |2023/5/3| | | |原宿店| | [5] |2023/5/2|渋谷店| 61| 220,000| [6] |2023/5/2|新宿店| 58| 220,000| [7] |2023/5/2|原宿店| 60| 220,000| [8] |2023/5/3|渋谷店| 62| 230,000| [9] |2023/5/3|新宿店| 67| 230,000| [10]|2023/5/3|原宿店| 57| 230,000| ※元表の入力条件は、3店舗のみで日付け順に 渋谷店、新宿店、原宿店の順番は変わらないものとします。 [ F:H ]範囲に、全店舗の日別集計をします。( ←これはできました。) [ J:L ]範囲に、店舗別集計をするのに、クラスに渡してできません。 ※店舗名だけは、強引?に渡してやりました。 しかし、K列とL列ができません。 ※また、K列とL列分については、別のクラスを作った方が 良いのでしょうか? どうやってすれば出来るか、ご指導願います。 次のマクロは、[ シート1 ]にレイアウトを作成し、集計をします。 Debug.Print も削除せず、そのままで醜いですが " UP " します。 Option Explicit 'クラスモジュール ( 全店舗日別集計 ） 'モジュールレベル変数を宣言 '********************************* Private 日付入力No As String Private 来店客数日別 As Long Private 全店舗日別売上 As Long Private 店舗名称 As String Rem : クラスのプロパティ(取得用) '***************************************************** Public Property Get 日付No() As String 日付No = 日付入力No End Property Public Property Get 来店客数() As Long 来店客数 = 来店客数日別 End Property Public Property Get 日別売上() As Long 日別売上 = 全店舗日別売上 End Property Public Property Get 店舗名() As String 店舗名 = 店舗名称 Debug.Print 店舗名 End Property Rem : クラスのプロパティ(変更用) '***************************************************** Public Property Let 日付No(ByVal GetNo As String) 日付入力No = GetNo Debug.Print GetNo End Property Public Property Let 来店客数(ByVal Get客数 As Long) 来店客数日別 = 来店客数日別 + Get客数 Debug.Print Get客数 End Property Public Property Let 日別売上(ByVal Get売上 As Long) 全店舗日別売上 = 全店舗日別売上 + Get売上 Debug.Print Get売上 Debug.Print 全店舗日別売上 End Property Public Property Let 店舗名(ByVal Get名前 As String) 店舗名称 = Get名前 Debug.Print 店舗名称 End Property '********************************************** Option Explicit '' 呼び出し元プロシージャ ( 標準モジュール ） Sub 売上集計() Dim 日付() As 全店舗日別集計 Dim 名前 As 全店舗日別集計 Dim 来店人数 As Long, 店舗売上 As Double Dim dicObje As Object Dim i&, n&, v&, q&, LastRow As Long Set dicObje = CreateObject("Scripting.Dictionary") Application.ScreenUpdating = False With Sheets(1) .UsedRange.Clear Stop: SHEET1_MAKE LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row For i = 2 To LastRow v = v + 1 If .Cells(i, 1) <> .Cells(i - 1, 1) Then n = n + 1 Debug.Print "n : " & n: Debug.Print v & "周目" '/// インスタンス生成 /////////////// ReDim Preserve 日付(n) Set 日付(n) = New 全店舗日別集計 日付(n).日付No = .Cells(i, 1) Set 名前 = New 全店舗日別集計 名前.店舗名 = .Cells(n + 1, 2) '' 日付Noをキーに、店舗名を読み込み dicObje.Add CStr(.Cells(i, 1)), 名前 End If q = q + 1 '/// 集計処理 /////////////////////// '' 日別売上をセット 日付(n).来店客数 = .Cells(i, 3) '' 日別売上をセット 日付(n).日別売上 = .Cells(i, 4) '************************************* .Cells(i, 3).Select '' Debug.Print 補助 Debug.Print "集計処理 : " & q & "ループ済" Debug.Print "-----------------------" '************************************* ' Stop Next i '' 別範囲に、集計を書き出す For i = 1 To n '' 日付 .Cells(i + 1, 6) = 日付(i).日付No '' 全店舗来店客数 .Cells(i + 1, 7) = 日付(i).来店客数 '' 全店舗日別集計 .Cells(i + 1, 8) = 日付(i).日別売上 '' 日付Noをキーに、支店名を書き出す .Cells(i + 1, 10) = dicObje(CStr(.Cells(i + 1, 6))).店舗名 来店人数 = Application.SumIf(.Range("B:B"), .Cells(i + 1, 10), .Range("C:C")) .Cells(i + 1, 11) = Round(来店人数 / 3, 1) 店舗売上 = Application.SumIf(.Range("B:B"), .Cells(i + 1, 10), .Range("D:D")) .Cells(i + 1, 12) = Round(店舗売上 / 来店人数, 1) '' インスタンス破棄 Set 名前 = Nothing Set 日付(i) = Nothing Next i .[A:L].EntireColumn.AutoFit End With Application.ScreenUpdating = True MsgBox "完了" End Sub Sub SHEET1_MAKE() With Sheets(1) .[A1] = "日付": .[B1] = "店舗名": .[C1] = "来店客数": .[D1] = "日別売上" .[F1] = "日付": .[G1] = "来店客数(全店)": .[H1] = "日別売上(全店)" .[J1] = "店舗名": .[K1] = "来店客数(平均)": .[L1] = "購入単価(平均)" .[B2] = "渋谷店": .[B3] = "新宿店": .[B4] = "原宿店" .[B2:B4].Copy .[B5:B7]: .[B2:B4].Copy .[B8:B10] .[A2] = "2023/05/01": .[A5] = "2023/05/02": .[A8] = "2023/05/03" .[A2:A4].DataSeries Type:=xlChronological, Date:=xlMonth, Step:=0 .[A5:A7].DataSeries Type:=xlChronological, Date:=xlMonth, Step:=0 .[A8:A10].DataSeries Type:=xlChronological, Date:=xlMonth, Step:=0 .[C2] = 56: .[C3] = 63: .[C4] = 59 .[C5] = 61: .[C6] = 58: .[C7] = 60 .[C8] = 62: .[C9] = 67: .[C10] = 57 .[D2] = 250000: .[D2].AutoFill Destination:=[D2:D4] .[D5] = 220000: .[D5].AutoFill Destination:=[D5:D7] .[D8] = 230000: .[D8].AutoFill Destination:=[D8:D10] .[A1:D1].Interior.Color = RGB(230, 230, 250) .[F1:H1].Interior.Color = RGB(230, 230, 250) .[J1:L1].Interior.Color = RGB(230, 230, 250) .[A1:L1].HorizontalAlignment = xlCenter Union(.Columns(2), Columns(10)).HorizontalAlignment = xlCenter Union(.Columns(5), Columns(9)).ColumnWidth = 2 Union(.Columns(4), Columns(8)).NumberFormatLocal = "#,###" '' 罫線処理 .[A1].Resize(10, 4).Borders.LineStyle = xlContinuous .[F1].Resize(4, 3).Borders.LineStyle = xlContinuous .[J1].Resize(4, 3).Borders.LineStyle = xlContinuous End With End Sub ※ その他 '************************************************************** *マクロのダメ出し *こんなマクロじゃ、最初から書き直した方が早い...とあらば 全訂正版のお手本を頂けると、もっと喜びます。（*'∀'人）♪ ＜ 使用 Excel:Excel2021、使用 OS:Windows11 ＞ ---- アドバイスできるほどの者ではないのですが、VBAでクラスのお勉強ができる機会は少ないので、教室のすみっこでガヤ担当としてお邪魔します。 確認なのですが、あみなさんの希望としては、標準モジュールで 来店人数 = 名前.来店員数平均 店舗売上 = 名前.店舗売上平均 ↑みたいに書くことが目的…という認識でよいですか? （じゃふ） 2023/05/08(月) 15:10:39 ---- ちわ〜^^ クラスと聞いて、頭がクラ〜としてますので。ご案内は遠慮いたしますが、すこぉしだけ 興味が御座いますので、応援がてら、傍観、傍聴、させて戴きます。どなたか、アドバイ スが有ると良いですね。^^;ふれーふれ〜123!yeyiee〜〜〜♪〜(*^ ^*)///初夏ですね〜 おや?実行すれば下記の通りになりましたけど。。。^^ 実験だけでもと。。。m(__)m |[A] |[B] |[C] |[D] |[E]|[F] |[G] |[H] |[I]|[J] |[K] |[L] [1] |日付 |店舗名|来店客数|日別売上| |日付 |来店客数(全店)|日別売上(全店)| |店舗名|来店客数(平均)|購入単価(平均) [2] |2023/5/1|渋谷店| 56| 250,000| |2023/5/1| 178| 750,000| |渋谷店| 59.7| 3910.6 [3] |2023/5/1|新宿店| 63| 250,000| |2023/5/2| 179| 660,000| |新宿店| 62.7| 3723.4 [4] |2023/5/1|原宿店| 59| 250,000| |2023/5/3| 186| 690,000| |原宿店| 58.7| 3977.3 [5] |2023/5/2|渋谷店| 61| 220,000| | | | | | | | [6] |2023/5/2|新宿店| 58| 220,000| | | | | | | | [7] |2023/5/2|原宿店| 60| 220,000| | | | | | | | [8] |2023/5/3|渋谷店| 62| 230,000| | | | | | | | [9] |2023/5/3|新宿店| 67| 230,000| | | | | | | | [10]|2023/5/3|原宿店| 57| 230,000| | | | | | | | （隠居Z） 2023/05/08(月) 15:14:12 ---- （じゃふ）さん、返信をありがとうございます。 え〜まだ...勉強初めたばかりなので回答として 正しいか解りませんが ＞みたいに書くことが目的…という認識でよいですか? Get くんと、Let くんは、別に増やしても大丈夫です。 ↓イメージであってます。たぶん^^; 来店人数 = 名前.来店員数平均 店舗売上 = 名前.店舗売上平均 そうそう、日付けを元に、名前を登録したので 次に、各店舗の名前を元に、集計のイメージです。 宜しくお願います。*_ _))ペコ （あみな） 2023/05/08(月) 15:47:04 ---- o(*'▽'*)/（隠居Z）ちゃま〜〜〜〜〜〜〜〜〜 ↓妥協したんぽォ…クラスに、入ってないですんΣ( ˙꒳˙ ;) 来店人数 = Application.SumIf(.Range("B:B"), .Cells(i + 1, 10), .Range("C:C")) .Cells(i + 1, 11) = Round(来店人数 / 3, 1) 店舗売上 = Application.SumIf(.Range("B:B"), .Cells(i + 1, 10), .Range("D:D")) .Cells(i + 1, 12) = Round(店舗売上 / 来店人数, 1) 宜しくお願います。*_ _))ペコ （あみな） 2023/05/08(月) 15:48:43 ---- 一例ということで。 だいぶ書き換えちゃいましたが '----- クラスモジュール clsShopData -------- Public ShopName Private mDateMin As Date Private mDateMax As Date Private mCustomer() As Variant Private mSales() As Variant Private Sub Class_Initialize() ReDim mCustomer(CLng(mDateMin) To CLng(mDateMax)) ReDim mSales(CLng(mDateMin) To CLng(mDateMax)) End Sub Public Property Let DateMin(newDay As Date) mDateMin = newDay If mDateMax < mDateMin Then mDateMax = mDateMin ReDim mCustomer(CLng(mDateMin) To CLng(mDateMax)) ReDim mSales(CLng(mDateMin) To CLng(mDateMax)) End Property Public Property Let DateMax(newDay As Date) mDateMax = newDay If mDateMax < mDateMin Then mDateMin = mDateMax ReDim Preserve mCustomer(CLng(mDateMin) To CLng(mDateMax)) ReDim Preserve mSales(CLng(mDateMin) To CLng(mDateMax)) End Property Public Property Get DateMin() As Date DateMin = mDateMin End Property Public Property Get DateMax() As Date DateMax = mDateMax End Property Public Property Let Customer(D As Date, newValue As Variant) mCustomer(CLng(D)) = newValue End Property Public Property Get Customer(D As Date) As Variant Customer = mCustomer(CLng(D)) End Property Public Property Let Sales(D As Date, newValue As Variant) mSales(CLng(D)) = newValue End Property Public Property Get Sales(D As Date) Sales = mSales(CLng(D)) End Property Public Property Get sumCustomer() sumCustomer = WorksheetFunction.Sum(mCustomer) End Property Public Property Get sumSales() sumSales = WorksheetFunction.Sum(mSales) End Property Public Property Get AveCustomer() AveCustomer = WorksheetFunction.Average(mCustomer) End Property Public Property Get AveSales() AveSales = WorksheetFunction.Average(mSales) End Property Public Function AddCustomer(D As Date, vCustomer As Variant) mCustomer(CLng(D)) = mCustomer(CLng(D)) + vCustomer End Function Public Function AddSales(D As Date, vSales As Variant) mSales(D) = mSales(D) + vSales End Function '------------- 標準モジュール -------------- Sub sample() Dim iRow As Long Dim ShopData() As clsShopData, nShop As Long With Worksheets(1) For iRow = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row For i = 1 To nShop If ShopData(i).ShopName = .Cells(iRow, 2) Then ShopData(i).AddCustomer .Cells(iRow, "A"), .Cells(iRow, "C") ShopData(i).AddSales .Cells(iRow, "A"), .Cells(iRow, "D") Exit For End If Next If i = nShop + 1 Then nShop = i ReDim Preserve ShopData(1 To nShop) Set ShopData(nShop) = New clsShopData ShopData(nShop).ShopName = .Cells(iRow, 2) ShopData(nShop).DateMin = WorksheetFunction.Min(.Columns("A")) ShopData(nShop).DateMax = WorksheetFunction.Max(.Columns("A")) ShopData(nShop).AddCustomer .Cells(iRow, "A"), .Cells(iRow, "C") ShopData(nShop).AddSales .Cells(iRow, "A"), .Cells(iRow, "D") End If Next Dim iDay As Long, minD As Long Dim sumCustomer As Long, sumSales As Long minD = ShopData(1).DateMin For iDay = ShopData(1).DateMin To ShopData(1).DateMax .Cells(iDay - minD + 2, "F") = CDate(iDay) sumCustomer = 0 sumSales = 0 For i = 1 To nShop sumCustomer = sumCustomer + ShopData(i).Customer(CDate(iDay)) sumSales = sumSales + ShopData(i).Sales(CDate(iDay)) Next .Cells(iDay - minD + 2, "G") = sumCustomer .Cells(iDay - minD + 2, "H") = sumSales Next For i = 1 To nShop .Cells(i + 1, "J").Value = ShopData(i).ShopName .Cells(i + 1, "K").Value = ShopData(i).AveCustomer .Cells(i + 1, "L").Value = ShopData(i).AveSales Next End With End Sub （´・ω・`） 2023/05/08(月) 16:34:11 ---- お返事ありがとうございます! さっきの書き込み、まちがえました（ついでに誤字もしました）。 ↓こう言いたかったです。 .Cells(i + 1, 11) = 名前.来店人数平均 .Cells(i + 1, 12) = 名前.店舗売上平均 お返事のおかげで、 ＞各店舗の名前を元に、集計のイメージ この認識は、共有させて頂けたと思います。 わたしはたぶん、「'' 別範囲に、集計を書き出す」以降の部分は標準モジュールに書いてしまう（クラス内でやらない）ので、わたしが書くと、あみなさんのお求めのものとは違った感じになっちゃいそうです。 なので、（´・ω・`）さんご提供の教材を読み解きつつ…引き続き、一緒にお勉強させてください。 （じゃふ） 2023/05/08(月) 17:01:27 ---- 来た..。キタワァ----*・゜・*:.。北---.:北---…連呼*・゜(n‘∀‘)ηﾟ・*:.。. .。.:*・゜・* ( ∩_∩)_旦‾‾お茶をどうぞ（´・ω・`）さん、ありがとうございます。 ※（´・ω・`）さんのを実行したら、↓下になりました。 |[J] |[K] |[L] [1]|店舗名|来店客数(平均)|購入単価(平均) [2]|渋谷店| 59.66666667| 233333.3333 [3]|新宿店| 62.66666667| 233333.3333 [4]|原宿店| 58.66666667| 233333.3333 ※↓こうするには、 |[J] |[K] |[L] [1]|店舗名|来店客数(平均)|購入単価(平均) [2]|渋谷店| 59.7| 3910.6 [3]|新宿店| 62.7| 3723.4 [4]|原宿店| 58.7| 3977.3 単純に↓下で良いでしょうか? For i = 1 To nShop .Cells(i + 1, "J").value = ShopData(i).ShopName .Cells(i + 1, "K").value = ShopData(i).AveCustomer .Cells(i + 1, "L").value = ShopData(i).AveSales / .Cells(i + 1, "K").value ←ココ Next それしか、わかりません。(〃ノдノ) 今から、分解しま〜〜〜〜〜す。Σ(ノ∀｀*)ペチッ （あみな） 2023/05/08(月) 17:33:03 ---- ＞ そうそう、日付けを元に、名前を登録したので ＞次に、各店舗の名前を元に、集計のイメージです。 クロス集計をクラスでやってみたいってことですよね。 クラスの良さはインスタンスを複数生成できることや、インテリセンスをつけることカナーと勝手に想像して 敢えて標準モジュールからのアクセスは入力と出力だけに絞って、集計までをクラスで行い なおかつ、1つのクラスを2段ロケット仕立てにして、可読性を「下げて」やりました。 標準モジュールは読みやすいのに、クラスは激読みにくいので、混乱しやがってください。 Option Explicit '■cls店舗別売上 Public IsChild As Boolean '二段ロケット用。同じメソッドでもTrue/Flaseで挙動が変わる Private dic As Object '店舗別、日付別、日付_店舗別にID（cnt）を付与 Private cnt As Long 'dicのID付与用 Private dicStore As Object '店舗のリスト作成用 Private slDate 'SortedListオブジェクト 日付のリスト作成用 Private Type Prop 'myData配列の構造体 キー名 As String 来客数 As Long 日別売上 As Long レコード数 As Long End Type Public Enum nData '出力データのインテリセンス?用 合計来客 = 0 合計売上 平均来客 平均売上 End Enum Private myData As Prop 'データを格納する変数 '店舗一覧の配列出力 Property Get Stores() As Variant Stores = dicStore.keys End Property '日付一覧の配列出力（並び替え済み） Property Get Dates() As Variant Dim i As Long Dim buf As Variant ReDim buf(0 To slDate.Count - 1) For i = 0 To slDate.Count - 1 buf(i) = slDate.getkey(i) Next Dates = buf End Property '定数nDataを指定して、キーの対となるデータを取得する Property Get GetData(ByVal キー As Variant, n As nData) As Double Dim v As cls店舗別売上 Dim buf As Double If IsChild = False Then If dic.Exists(キー) = True Then Set v = dic(キー) buf = v.GetData(キー, n) Else buf = 0 End If Else '二段ロケット部分 '自分自身を呼び出した場合（IsChild=True）、データを出力する Select Case n Case nData.合計売上 buf = myData.日別売上 Case nData.合計来客 buf = myData.来客数 Case nData.平均売上 buf = myData.日別売上 / myData.来客数 Case nData.平均来客 buf = myData.来客数 / myData.レコード数 End Select End If GetData = buf End Property 'データを入れるメソッド Sub Add(ByVal 店舗名 As String, ByVal 売上日 As Date, ByVal 来客数 As Long, ByVal 日別売上 As Long, Optional ByVal キー As Variant) If IsChild = False Then '標準モジュールから呼び出された場合（IsChild = False）の処理 'dicに集計したい要素をArrayでループして、 'dicに自分自身のインスタンスを生成する Dim tmp As String Dim c As Variant, k As Variant tmp = Format$(売上日, "yyyymmdd") '店舗と売上日の一覧用 dicStore(店舗名) = dicStore(店舗名) + 1 slDate(売上日) = slDate(売上日) + 1 '集計したい要素の配列を準備 For Each k In Array(店舗名, 売上日, tmp & "_" & 店舗名) If dic.Exists(k) Then Set c = dic(k) c.Add 店舗名, 売上日, 来客数, 日別売上, k Set dic(k) = c Else Set c = New cls店舗別売上 c.IsChild = True '自分自身を呼び出した場合、Trueにセットする c.Add 店舗名, 売上日, 来客数, 日別売上, k Set dic(k) = c End If Next Else '二段ロケット部分 '自分自身を呼び出した場合（IsChild=True）、データを格納する With myData .キー名 = 店舗名 .来客数 = .来客数 + 来客数 .日別売上 = .日別売上 + 日別売上 .レコード数 = .レコード数 + 1 End With End If End Sub Private Sub Class_Initialize() Set dic = CreateObject("Scripting.Dictionary") Set dicStore = CreateObject("Scripting.Dictionary") Set slDate = CreateObject("System.Collections.SortedList") cnt = -1 End Sub Option Explicit '■標準モジュール Sub test() Dim tbl As Variant, i As Long Dim cls As cls店舗別売上 Dim ans As Variant tbl = Sheets("Sheet1").Range("A1").CurrentRegion.Value Set cls = New cls店舗別売上 ' 'クラスモジュールにデータを入力 For i = 2 To UBound(tbl, 1) cls.Add tbl(i, 2), tbl(i, 1), tbl(i, 3), tbl(i, 4) '★<-インプットはこれだけ! Next i ' '日別合計出力 With Sheets("Sheet1") .Range("F2:F4").Value = Application.Transpose(cls.Dates) ans = .Range("F2:H4").Value For i = 1 To UBound(ans, 1) ans(i, 2) = cls.GetData(ans(i, 1), 合計来客) '<-★ここの第二引数が , を打つと表示されるようにした。 ans(i, 3) = cls.GetData(ans(i, 1), 合計売上) Next i .Range("F2:H4").Value = ans End With ' '店舗別平均出力 With Sheets("Sheet1") .Range("J2:J4").Value = Application.Transpose(cls.Stores) ans = .Range("J2:L4").Value For i = 1 To UBound(ans, 1) ans(i, 2) = cls.GetData(ans(i, 1), 平均来客) ans(i, 3) = cls.GetData(ans(i, 1), 平均売上) Next i .Range("J2:L4").Value = ans End With MsgBox "出力しました" End Sub （稲葉） 2023/05/08(月) 17:37:25 ---- 済みません どういう計算してるか理解してませんでした 売り上げの日平均ではなく、顧客当たりの平均なんですね For i = 1 To nShop .Cells(i + 1, "J").Value = ShopData(i).ShopName .Cells(i + 1, "K").Value = ShopData(i).AveCustomer .Cells(i + 1, "L").Value = ShopData(i).sumSales / ShopData(i).sumCustomer Next ですね （´・ω・`） 2023/05/08(月) 17:39:07 ---- ＞↓こう言いたかったです。 ＞.Cells(i + 1, 11) = 名前.来店人数平均 ＞.Cells(i + 1, 12) = 名前.店舗売上平均 （じゃふ）さん...そうそう、間違いないです。 （´・ω・`）さんのを見て、まだパット見で解りませんが 私が、Dictionary でしようかな〜とイメージしたのが そもそも、間違いかもと...Σ(ノ∀｀*)ペチッ （あみな） 2023/05/08(月) 17:45:03 ---- ε=ε=(*￣ー)ノノ …来たー来たー。 。・*・:≡( ε:) ・*・:≡( ε:) 2段ロケット ( ∩_∩)_旦 オチャドウゾー 稲葉さん、ありがとうございます。 ＞クロス集計をクラスでやってみたいってことですよね。 これが出来ると思ってなかったので…どうするのかなと? 出来れば、クラス内での処理が、理想です。 ＞標準モジュールは読みやすいのに、クラスは激読みにくいので、混乱しやがってください。 は〜い、既に頭の中(ノω<;)混乱してますぽォ 【 initialize 】イニシャライズ くんの所にある ↓下のこの子…初めて見たぽォ Set slDate = CreateObject("System.Collections.SortedList") パット見ただけでは、さっぱり判りませんΣ(ノ∀｀*)ペチッ いや〜これ解読できるかな (^^ゞ （あみな） 2023/05/08(月) 18:32:46 ---- （´・ω・`）さんの読みやすくて勉強になるなぁ・・・。 ショップ名と日付で集計掛けたい場合、Letの部分で合計してってあげて Public Property Let Customer(D As Date, newValue As Variant) mCustomer(CLng(D)) = newValue + mCustomer(CLng(D)) ‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ End Property 呼び出すときに日付指定してあげれば、店舗と日付のクロス集計が出力できる感じですか? rng.Value = ShopData(i).Customer(#5/1/2023#) あみなさんへ （´・ω・`）さんのこの部分がDictionary(ShopName)の配列の役割しているから、あみなさんがやろうとすれば For iRow = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row For i = 1 To nShop If ShopData(i).ShopName = .Cells(iRow, 2) Then こんな感じに置き換えれば、Dictionaryでもできそうですね。 For iRow = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row k = .Cells(iRow, 2) If dic.Exists(k) Then Set ShopData = dic(k) SortedList http://www.eurus.dti.ne.jp/‾yoneyama/Excel/vba/vba_sortedlist.html 滅多に使わないのですが、DictionaryとArrayList組み合わせたような?使い勝手が良かったので 日付の出力にちょうどイイカナーと思って採用した次第です。 ちなみに、二段ロケットにしなくても、myDataを配列にしてあげれば平面で対応できます。 あえて二段ロケットにしました・・・。 （稲葉） 2023/05/08(月) 18:40:45 ---- ＞どういう計算してるか理解してませんでした 売り上げの日平均ではなく、顧客当たりの平均なんですね （´・ω・`）さん、ありがとうございます。 顧客当たりの平均なんです…そうですそうです。 ↓下ですか? .Cells(i + 1, "L").Value = ShopData(i).sumSales / ShopData(i).sumCustomer えっ^^; （あみな） 2023/05/08(月) 18:46:12 ---- 稲葉さん、待って ヾ(∂o∂ヾ) ストップ。ﾟ(PД`q*)ﾟ。.マッテーッチョウチョマ...、タイム(・∀・;) " 速過ぎて、脳みそが...ついて行けないォ∵:.ブッ.:∵ ↓下の時間のコメントは、明日以降の返信になります （稲葉） 2023/05/08(月) 18:40:45 [ 新鮮な空気を、脳内へ入れて来ます。] λ…………トボトボ （あみな） 2023/05/08(月) 19:23:23 ---- （´・ω・`） 2023/05/08(月) 16:34:11のコードはあえてDictionary使わないシバリでかいたものです Dictionary使ってOKならクラス使わないでもさらっと書けるので... たとえば、 Sub sample1() Dim DailyCustomer As Dictionary, DailySales As Dictionary Dim ShopCustomer As Dictionary, ShopSales As Dictionary Dim D As Date, ShopName As String, Customer As Long, Sales As Long Dim iRow As Long Set DailyCustomer = New Dictionary Set DailySales = New Dictionary Set ShopCustomer = New Dictionary Set ShopSales = New Dictionary With Sheets(1) For iRow = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row D = .Cells(iRow, "A") ShopName = .Cells(iRow, "B") Customer = .Cells(iRow, "C") Sales = .Cells(iRow, "D") If DailyCustomer.Exists(D) Then DailyCustomer(D) = DailyCustomer(D) + Customer Else DailyCustomer.Add D, Customer If DailySales.Exists(D) Then DailySales(D) = DailySales(D) + Sales Else DailySales.Add D, Sales If ShopCustomer.Exists(ShopName) Then ShopCustomer(ShopName) = ShopCustomer(ShopName) + Customer Else ShopCustomer.Add ShopName, Customer If ShopSales.Exists(ShopName) Then ShopSales(ShopName) = ShopSales(ShopName) + Sales Else ShopSales.Add ShopName, Sales Next For i = 0 To DailyCustomer.Count - 1 Key = DailyCustomer.Keys(i) .Cells(i + 2, "F").Value = Key .Cells(i + 2, "G").Value = DailyCustomer(Key) .Cells(i + 2, "H").Value = DailySales(Key) Next For i = 0 To ShopCustomer.Count - 1 Key = ShopCustomer.Keys(i) .Cells(i + 2, "J").Value = Key .Cells(i + 2, "K").Value = ShopCustomer(Key) / DailyCustomer.Count .Cells(i + 2, "L").Value = ShopSales(Key) / ShopCustomer(Key) Next End With End Sub という感じ。で、これをあえてクラスを使って書きます。ずるいです。 '------- クラスモジュール clsShopDate ------------- Private mDailyCustomer As Dictionary Private mDailySales As Dictionary Private mShopCustomer As Dictionary Private mShopSales As Dictionary Private Sub Class_Initialize() Set mDailyCustomer = New Dictionary Set mDailySales = New Dictionary Set mShopCustomer = New Dictionary Set mShopSales = New Dictionary End Sub Public Property Let Customer(Optional ByVal D As Date, Optional ByVal ShopName As String, newCustomerValue As Long) If mDailyCustomer.Exists(D) Then mDailyCustomer(D) = mDailyCustomer(D) + newCustomerValue Else mDailyCustomer.Add D, newCustomerValue If mShopCustomer.Exists(ShopName) Then mShopCustomer(ShopName) = mShopCustomer(ShopName) + newCustomerValue Else mShopCustomer.Add ShopName, newCustomerValue End Property Public Property Let Sales(Optional ByVal D As Date, Optional ByVal ShopName As String, newSalesValue As Long) If mDailySales.Exists(D) Then mDailySales(D) = mDailySales(D) + newSalesValue Else mDailySales.Add D, newSalesValue If mShopSales.Exists(ShopName) Then mShopSales(ShopName) = mShopSales(ShopName) + newSalesValue Else mShopSales.Add ShopName, newSalesValue End Property Public Property Get DailyCustomer() As Dictionary Set DailyCustomer = mDailyCustomer End Property Public Property Get DailySales() As Dictionary Set DailySales = mDailySales End Property Public Property Get ShopCustomer() As Dictionary Set ShopCustomer = mShopCustomer End Property Public Property Get ShopSales() As Dictionary Set ShopSales = mShopSales End Property '------- 標準モジュール --------- Sub sample2() Dim ShopData As clsShopData Dim D As Date, ShopName As String, Customer As Long, Sales As Long Set ShopData = New clsShopData With Sheets(1) For iRow = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row D = .Cells(iRow, "A") ShopName = .Cells(iRow, "B") Customer = .Cells(iRow, "C") Sales = .Cells(iRow, "D") ShopData.Customer(D, ShopName) = Customer ShopData.Sales(D, ShopName) = Sales Next For i = 0 To ShopData.DailyCustomer.Count - 1 Key = ShopData.DailyCustomer.Keys(i) .Cells(i + 2, "F").Value = Key .Cells(i + 2, "G").Value = ShopData.DailyCustomer(Key) .Cells(i + 2, "H").Value = ShopData.DailySales(Key) Next For i = 0 To ShopData.ShopCustomer.Count - 1 Key = ShopData.ShopCustomer.Keys(i) .Cells(i + 2, "J").Value = Key .Cells(i + 2, "K").Value = ShopData.ShopCustomer(Key) / ShopData.DailyCustomer.Count .Cells(i + 2, "L").Value = ShopData.ShopSales(Key) / ShopData.ShopCustomer(Key) Next End With End Sub （´・ω・`） 2023/05/09(火) 09:39:07 ---- クラスにこういうことしておいて Public Property Get AveCustomer(D) AveCustomer = mShopCustomer(D) / mDailyCustomer.Count End Property Public Property Get AveSalse(Shopname) AveSalse = mShopSales(Shopname) / mShopCustomer(Shopname) End Property こんな感じで書き込めればいいのかな For i = 0 To ShopData.ShopCustomer.Count - 1 key = ShopData.ShopCustomer.Keys(i) .Cells(i + 2, "J").Value = key .Cells(i + 2, "K").Value = ShopData.AveCustomer(key) .Cells(i + 2, "L").Value = ShopData.AveSalse(key) Next （´・ω・`） 2023/05/09(火) 10:33:56 ---- ・*•(*・ω・*).•* 皆様...オハヨウゴザイマス♪¨* 。。。もうお昼ですが… （´・ω・`）さん、ありがとうございます。 2023/05/09(火) 09:39:07 すぐ上の↑ Dictionary くんは 参照設定がいる子ですね。 これは、最初のより3倍位...読みやすいです。 可読性Good 〜(d´∀`*)グッ 技を盗まさせて貰います。...ドロボー ٩(*´꒳`*)۶ です!! ↓最初の ＞一例ということで。 ＞だいぶ書き換えちゃいましたが 2023/05/08(月) 16:34:11 分は、 まだ 8割 〜 9割りしか解読を出来ていませんが Private Sub Class_Initialize() ←（ ★コンストラクタ ）無しでもイケるし Public Property Let DateMax(newDay As Date) mDateMax = newDay If mDateMax < mDateMin Then mDateMin = mDateMax ''★この 1行無しでもイケるし ReDim Preserve mCustomer(CLng(mDateMin) To CLng(mDateMax)) ReDim Preserve mSales(CLng(mDateMin) To CLng(mDateMax)) End Property 虐めかと思いました。(笑) 正直クラスは、どこ迄必要性があるか解りませんでしたが この、Dictionary くんの使い方が出来るなら、クラスのお勉強に拍車がかかります。 ‎引き続き、研究をさせていただきます( *˙ω˙*)و （あみな） 2023/05/09(火) 12:32:56 ---- 稲葉さんへ ↓この子、メチャクチャ優秀な子ですね。 CreateObject("System.Collections.SortedList") 重複なしのデータを作成し、並べ替えるという手順が 簡略化できる言う、頼もし過ぎる… 稲葉さんの、マクロの解読はまだ追いついてませんが ↓これは楽そー cls.Add tbl(i, 2), tbl(i, 1), tbl(i, 3), tbl(i, 4) '★<-インプットはこれだけ! ちょっと、先に Class_Initialize くんのお勉強をしてきます。 3年程前に、したんですが…既に忘れたのでΣ(ノ∀｀*)ペチッ （あみな） 2023/05/09(火) 12:34:57 ---- ちょっと修正Ver 最後です 標準モジュールのコードがさらに整理された感じになりました。 '----------- clsShopData ------------------- Private mDailyCustomer As Dictionary Private mDailySales As Dictionary Private mShopCustomer As Dictionary Private mShopSales As Dictionary Private Sub Class_Initialize() Set mDailyCustomer = New Dictionary Set mDailySales = New Dictionary Set mShopCustomer = New Dictionary Set mShopSales = New Dictionary End Sub Public Property Let Customer(Optional ByVal D As Date, Optional ByVal ShopName As String, newCustomerValue As Long) If mDailyCustomer.Exists(D) Then mDailyCustomer(D) = mDailyCustomer(D) + newCustomerValue Else mDailyCustomer.Add D, newCustomerValue If mShopCustomer.Exists(ShopName) Then mShopCustomer(ShopName) = mShopCustomer(ShopName) + newCustomerValue Else mShopCustomer.Add ShopName, newCustomerValue If Not mDailySales.Exists(D) Then mDailySales.Add D, 0 If Not mShopSales.Exists(ShopName) Then mShopSales.Add ShopName, 0 End Property Public Property Let Sales(Optional ByVal D As Date, Optional ByVal ShopName As String, newSalesValue As Long) If mDailySales.Exists(D) Then mDailySales(D) = mDailySales(D) + newSalesValue Else mDailySales.Add D, newSalesValue If mShopSales.Exists(ShopName) Then mShopSales(ShopName) = mShopSales(ShopName) + newSalesValue Else mShopSales.Add ShopName, newSalesValue If Not mDailyCustomer.Exists(D) Then mDailyCustomer.Add D, 0 If Not mShopCustomer.Exists(ShopName) Then mShopCustomer.Add ShopName, 0 End Property Public Property Get DailyCustomer(D) DailyCustomer = mDailyCustomer(D) End Property Public Property Get DailySales(D) DailySales = mDailySales(D) End Property Public Property Get ShopCustomer(ShopName) Set ShopCustomer = mShopCustomer(ShopName) End Property Public Property Get ShopSales(ShopName) Set ShopSales = mShopSales(ShopName) End Property Public Property Get DateList(Optional ByVal i) If IsMissing(i) Then DateList = mDailyCustomer.Keys Else DateList = mDailyCustomer.Keys(i - 1) End Property Public Property Get ShopList(Optional ByVal i) If IsMissing(i) Then ShopList = mShopCustomer.Keys Else ShopList = mShopCustomer.Keys(i - 1) End Property Public Property Get AveCustomer(D) AveCustomer = mShopCustomer(D) / mDailyCustomer.Count End Property Public Property Get AveSalse(ShopName) AveSalse = mShopSales(ShopName) / mShopCustomer(ShopName) End Property Public Property Get DateCount() As Long DateCount = mDailyCustomer.Count End Property Public Property Get ShopCount() As Long ShopCount = mShopCustomer.Count End Property Public Sub AddRecord(D, ShopName, Customer, Sales) Me.Customer(D, ShopName) = Customer Me.Sales(D, ShopName) = Sales End Sub '----------- 標準モジュール ------------------- Sub sample2() Dim ShopData As clsShopData Dim D As Date, ShopName As String, Customer As Long, Sales As Long Set ShopData = New clsShopData With Sheets(1) For iRow = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row D = .Cells(iRow, "A") ShopName = .Cells(iRow, "B") Customer = .Cells(iRow, "C") Sales = .Cells(iRow, "D") ShopData.AddRecord D, ShopName, Customer, Sales Next iRow = 2 For i = 1 To ShopData.DateCount D = ShopData.DateList(i) .Cells(iRow, "F").Value = D .Cells(iRow, "G").Value = ShopData.DailyCustomer(D) .Cells(iRow, "H").Value = ShopData.DailySales(D) iRow = iRow + 1 Next iRow = 2 For i = 1 To ShopData.ShopCount ShopName = ShopData.ShopList(i) .Cells(iRow, "J").Value = ShopName .Cells(iRow, "K").Value = ShopData.AveCustomer(ShopName) .Cells(iRow, "L").Value = ShopData.AveSalse(ShopName) iRow = iRow + 1 Next End With End Sub （´・ω・`） 2023/05/09(火) 13:03:55 ---- ＞ちょっと修正Ver 最後です ＞標準モジュールのコードがさらに整理された感じになりました。 （´・ω・`）さん、ありがとうございます。 えっとー^^; 2023/05/09(火) 13:03:55 の最終版に使用している 標準モジュールの↓この AddRecordメソッド? ってなんですか? ShopData.AddRecord D, ShopName, Customer, Sales ‾‾‾‾‾‾‾‾‾‾ マクロは、ちゃんと動いてます。 少々、詳しく教えてください。。´_ _))ペコ （あみな） 2023/05/09(火) 16:21:31 ---- ShopData.AddRecord は ShopData.Customer(D, ShopName) = Customer ShopData.Sales(D, ShopName) = Sales をまとめて実行するメソッドです （´・ω・`） 2023/05/09(火) 16:24:06 ---- AddRecord VBA ↑検索しても、詳しい情報がでてきませんね。（ ; ; ） ありがとうございます。 （あみな） 2023/05/09(火) 16:49:04 ---- クラスの中で、 Public Sub AddRecord(D, ShopName, Customer, Sales) Me.Customer(D, ShopName) = Customer Me.Sales(D, ShopName) = Sales End Sub と定義しているんですよ....と なので、ググっても出てきません （´・ω・`） 2023/05/09(火) 16:53:57 ---- (*´꒳`*)/ハイ …頑張って読み解きます。 現在、稲葉さんのマクロを...解読始めたので （´・ω・`）さんの、下記の二つのマクロを 読み解くのは、明日以降になります。 *2023/05/09(火) 09:39:07 分 *2023/05/09(火) 13:03:55 分 また、解らないことが出てくる思うので、 質問させて頂きます。 よろしく、お願いします。 （あみな） 2023/05/09(火) 18:14:48 ---- いや私の読まないでいいですよ。 クラスっぽい処理してないので・・・ （稲葉） 2023/05/09(火) 19:13:05 ---- ・*•(*・ω・*).•* 皆様...オハヨウゴザイマス♪¨* (稲葉)さんのマクロを、解読しようと試みましたが 大きな流れだけ理解して、諦めました。 仮に、完璧に理解が出来たとしても 絶対に書けません。(´;ω;` )ウウッ （あみな） 2023/05/10(水) 08:46:34 ---- ふーむ、私には初めからピンと来なかったです。 その後も難しい話が展開するので、能力的について行けない状態であります。 一体何のクラスなんですか? 集計クラスなんですか? クラスのメインな使い方としては、 設計図を一つ作り、それを元に複数のインスタンスを作ってコスパよくプログラミングする と言うのがあります。 なので、私が最初に思ったのは、 店舗クラスを作るんだろうな。 そのクラスに、日別来店客数、日別売上、平均来店客数、平均購入単価の各プロパティを持たせたらいいかな。 標準モジュールでそれらインスタンスを操作して結果を出させればいいんだろうな。 プロパティプロシージャを具体的にどう作るかは、本トピックにとっては2次的な話だと思っています。 Dictionaryを使っていいだとか、なんだとかは、もう3次的な話に過ぎないのでは? （半平太） 2023/05/10(水) 10:54:47 ---- 半平太さんのおっしゃりたい核が分かってないですが、私はこんな感じで考えてましたってことを・・・。 ＞ 設計図を一つ作り、それを元に複数のインスタンスを作ってコスパよくプログラミングする これは要するに、何をキーにデータ（インスタンス）を持たせるかってことですよね。 1）日付をキーにデータを持たせれば、日付別の売上合計へ平均は出せるが、店舗別の集計は出せない 2）店舗をキーにデータを持たせれば、店舗別の売上合計へ平均は出せるが、日付別の集計は出せない 3）店舗_日付をキーにデータを持たせれば、店舗_日付別の売上合計へ平均は出せるが、店舗別や日付別の集計は出せない あみなさんが聞きたかったのは、1）まではできたけど、2）が1つのクラス（インスタンス）で できなかったので、どうすれば1つのクラス（インスタンス）で2つの集計結果が出せますか? という質問だと理解して、回答（おふざけですが）した次第です。 今回の趣旨で行くと、ユーザー定義の構造体をDictionaryにぶち込めれば一番コスパいいんだけど、 仕方がないから構造体をクラスにしてあげる、っていう方向性がいいような気がしました。 （稲葉） 2023/05/10(水) 12:03:29 ---- （稲葉）さん、ありがとうございます。(o_ _)o 上手に説明が出来なかったので 要約いただいてありがとうございます。 （あみな） 2023/05/10(水) 12:20:32 ---- 半平太さんの投稿 2023/05/10(水) 10:54:47 は、あみなさんに対する問いかけなのでしょうか? ↑この確認は、「一体何のクラスなんですか?」という問いかけが非常に本質的なものだと感じたので、一般論として、質問スレッドをたてた側に投げかけるには重たいのでは…と考えたためのものです。 （じゃふ） 2023/05/10(水) 12:23:50 ---- （半平太）さん...(*´∀`*)ノ コンニチワ 私はまだクラスの事が、ほぼ解っていません。 集計クラスの課題として、取り組んでいますが ＞クラスのメインな使い方としては、設計図を一つ作り、 設計図と言われても、その土台の作り方?さえも解りません。 出来るだけ簡単に、汎用性の利くマクロが嬉しいです。 教えていただけますでしょうか? ＞Dictionaryを使っていいだとか、なんだとかは、 ＞もう3次的な話に過ぎないのでは? 重複した場合の処理を、どうしたら良いか 解らないので、私が適当に始めただけなので （´・ω・`）さんの、クラス Dictionary版でも 私には、難易度が高いです。 方法の一つとして、解読を始めておりますが Dictionaryくんを使用しないでも、全く大丈夫です。 宜しくお願いします。(o_ _)o （あみな） 2023/05/10(水) 12:25:58 ---- あっ、あみなさんだ。お邪魔してます。 確認しておきたかったのですけれども、質問時点で「（山川海湖）さんの影響を受けて」とおっしゃっていたのは、具体的に↓のスレッドで間違いないでしょうか? [[20230503082502]] （じゃふ） 2023/05/10(水) 12:32:31 ---- ＞ 出来るだけ簡単に、汎用性の利くマクロが嬉しいです。 私も考えたことがあって、今はそう思ってないですが 汎用性のあるものは、ほんとに単一機能にとどめたほうがいいと思いますよ。 （稲葉） 2023/05/10(水) 12:46:49 ---- （じゃふ）さん...・ω・*)ノコンニチワ♪ ＞お邪魔してます。 ( ∩_∩)_旦 オチャドウゾーごゆっくりしていってください。 もう既に、クラスを制覇して 閲覧していないかと思っていました。 ＞質問時点で「（山川海湖）さんの影響を受けて」とおっしゃっていたのは、 ＞具体的に↓のスレッドで間違いないでしょうか? はい、そうです。間違いありません。 難かしくて、全然わかりませんが…私はどちらかと言うと UserForm系が好きで、ComboBoxは、その中でもかなり好きな方でして 楽しみにしていたのですが、完結って感じではなかったので 取り敢えず何かやってみようと…思い立ったのですが 最初から、クロス集計はいささか荷が重すぎまして...Σ(ノ∀｀*)ペチッ ●●さんから、あみなには...まだ早いと” 虐めの洗礼 ”を受けた次第です。(笑) これを、読んでみろと、;'.(;ˊ艸ˋ)ゥ*。':;ブハッ （あみな） 2023/05/10(水) 13:24:55 ---- （稲葉）さん...・ω・*)ノコンニチワ♪ ＞私も考えたことがあって、今はそう思ってないですが ＞汎用性のあるものは、ほんとに単一機能にとどめたほうがいいと思いますよ。 ハーヾ(。˃ ᵕ ˂ )ノﾞ-イ…頑張ります。 （あみな） 2023/05/10(水) 13:27:11 ---- ＞半平太さんの投稿 2023/05/10(水) 10:54:47 は、あみなさんに対する問いかけなのでしょうか? 直接的にはそうですが、回答を書いた人(質問を理解した人)、見ている人全員で構いません。 なんか話がごっちゃになっている気がするんですが、 まさか、サンプルの課題が、実際の課題でもあるって訳じゃないですよね? 実際の課題なら、この案件でクラスなんて先ず作らないと思うのですが。 ※それを敢えて一つのクラスを作ってやりたいってことなんですかねぇ・・ 回答案を作った人はどういう解釈だったんでしょうか、お聞きしたいものです。 こりゃいいアイデアだ、一肌脱ぎましょう、ってことなんですかねぇ。。 （半平太） 2023/05/10(水) 13:35:38 ---- クラスの勉強のためっていうことなので、最初から手段が目的化してるんだなって思ってました >実際の課題なら、この案件でクラスなんて先ず作らないと思うのですが。 そう思います 勉強と割り切ればDictionaryと同じような(下位互換の)機能をクラスで実装してみるのも練習の一つ と考えて、最初に書いたのが（´・ω・`） 2023/05/08(月) 16:34:11 でもやっぱり便利なDictionary。 Dictinaryをクラス内部に隠蔽して使い方を簡略化する方向性を目指したのが（´・ω・`） 2023/05/09(火) 13:03:55 その中間の中途半端なのが、（´・ω・`） 2023/05/09(火) 09:39:07 のsample2 再度、 >実際の課題なら、この案件でクラスなんて先ず作らないと思うのですが。 ピボットテーブルでもできますし、365ならワークシート関数でできますし、 作表の結果だけ欲しいなら（´・ω・`） 2023/05/09(火) 09:39:07 のsample1を最初に書くかも知れません あみなさんが 2023/05/09(火) 12:32:56 でこう書いてますが >正直クラスは、どこ迄必要性があるか解りませんでしたが この課題だと、クラスの必要性ってあまりないよなぁと思いながら、 とりあえず勉強用のサンプルコードとして仕上げました COMオブジェクトで便利な機能が沢山ある現状では、 自分でクラスを使って何かコードを書くってことが少ないので 練習に使わせてもらったという一面もあります （´・ω・`） 2023/05/10(水) 14:11:57 ---- クラスの勉強しますっていってる人に、 もっといい方法があるのでその勉強はやめなさいって言うのが正義だと 半平太さんは、そういうことを言ってるのでしょうか? （´・ω・`） 2023/05/10(水) 14:35:50 ---- ＞見ている人全員で構いません。 わたしの当初の見解は 2023/05/08(月) 17:01:27 に書いたとおり、「わたしはたぶん、「'' 別範囲に、集計を書き出す」以降の部分は標準モジュールに書いてしまう（クラス内でやらない）」です。 けれど、クラスというものをそこまで理解できていないので、なにかいいアイデアがあるのかも（ないならないで、その判断も聞きたい）、と末席に参加しました。 あみなさんの質問の趣旨は、 「店舗別集計をするのに、クラスに渡してできません。」 「どうやってすれば出来るか、ご指導願います。」 という点であり、クラスにすることの是非はいったん問わないものであると受け取りました。 クラスについてよく理解されている方から見ると、課題の設定が適切でない、と感じられるのかもしれませんが、「クラスについて学びたい」という段階で「課題設定が適切かどうか」を判断するのは、私には無理です。 ですので、そこを咎められると、当たって砕けろ!ができなくなっちゃって辛いなぁ…という感想です。 （じゃふ） 2023/05/10(水) 14:52:42 ---- シートに書き込みまで作っていませんが、 Dictionaryを使用してこんな感じはどうでしょう? +++ Classモジュール ++++ Private Dic日付 As Object Private Dic店舗 As Object Public Sub SetDictonary() 'Dictionaryのインスタンス作成 Set Dic日付 = CreateObject("Scripting.Dictionary") Set Dic店舗 = CreateObject("Scripting.Dictionary") End Sub Public Property Get 集計(ByVal 集計タイプ As Variant) As Variant ' Select Case TypeName(集計タイプ) Case "Date": 集計 = Dic日付.Item(集計タイプ) Case "String": 集計 = Dic店舗.Item(集計タイプ)(2) End Select End Property Public Property Let 集計(ByVal 集計タイプ As Variant, ByVal 来店客数 As Variant) ' Dim cnt As Long Dim 合計 As Double Dim 平均 As Double Select Case TypeName(集計タイプ) Case "Date" '日付の場合 If Dic日付.exists(集計タイプ) Then '同じ日付があれば入力値を加算して古いデータをDictionaryから削除 合計 = 来店客数 + Dic日付.Item(集計タイプ) Dic日付.Remove 集計タイプ Else 合計 = 来店客数 End If Dic日付.Add 集計タイプ, 合計 Case "String" '店舗の場合 If Dic店舗.exists(集計タイプ) Then '同じ店舗があれば入力値を計算して古いデータをDictionaryから削除 cnt = Dic店舗.Item(集計タイプ)(1) + 1 合計 = 来店客数 + Dic店舗.Item(集計タイプ)(0) 平均 = 合計 / cnt Dic店舗.Remove 集計タイプ Else cnt = 1 合計 = 来店客数 End If Dic店舗.Add 集計タイプ, Array(合計, cnt, 平均) End Select End Property +++ 標準モジュール +++ Sub Sample() 'クラスのインスタンス作成 Dim cls(0 To 1) As Class1 Set cls(0) = New Class1 '日付用 Set cls(1) = New Class1 '店舗用 Dim r As Long, c As Long Dim Av As Variant, Bv As Variant, Cv As Long 'Property用Dictionaryのインスタンス作成 cls(0).SetDictonary cls(1).SetDictonary 'データをPropertyに書き込み For r = 2 To Cells(Rows.Count, "A").End(xlUp).Row Av = Cells(r, "A").Value '日付 Bv = Cells(r, "B").Value '店舗 For c = 0 To 1 Cv = Cells(r, "C").Offset(0, c).Value '来客数と売り上げ With cls(c) .集計(Av) = Cv '日付で書き込み .集計(Bv) = Cv '店舗で書き込み End With Next i Next r Debug.Print cls(0).集計(Cells(2, 1).Value), cls(1).集計(Cells(2, 1).Value) Debug.Print cls(0).集計(Cells(2, 2).Value), cls(1).集計(Cells(2, 2).Value) End Sub 一応数値的にはきちんと出ています。 （ 'ふ'） 2023/05/10(水) 15:00:36 ---- ＞UserForm系が好きで、ComboBoxは、その中でもかなり好きな方でして ＞楽しみにしていたのですが、完結って感じではなかったので ＞取り敢えず何かやってみようと…思い立ったのですが あっちのスレッドでも書かれていますが、イベントを拾わないなら、クラス化する意味がほとんどないですよ・・・。 [[20230331101731]] 『ポップアップでカレンダーを出す方法』（波冠） こっちの白茶さんが提示してくださったコードのうち Private WithEvents Btn11 As MSForms.CommandButton 〜 Private WithEvents Btn67 As MSForms.CommandButton この部分をクラスにしてコールバックすることで疑似配列が作れて、変数宣言しなくても使えるので メインのプロシジャのコーティングを楽にできますよ どうせ勉強するなら、白茶さんのコードそのままお借りして、 クラスでイベントを拾う方法勉強されてもいいかもしれないです! （稲葉） 2023/05/10(水) 15:07:16 ---- Classモジュールの方はやっぱりこっちで Private Dic As Object Public Sub SetDictonary() 'Dictionaryのインスタンス作成 Set Dic = CreateObject("Scripting.Dictionary") End Sub Public Property Get 集計(ByVal 集計タイプ As Variant) As Variant ' Select Case TypeName(集計タイプ) Case "Date": 集計 = Dic.Item(集計タイプ)(0) Case "String": 集計 = Dic.Item(集計タイプ)(2) End Select End Property Public Property Let 集計(ByVal 集計タイプ As Variant, ByVal データ As Variant) ' Dim cnt As Long Dim 合計 As Double Dim 平均 As Double If Dic.exists(集計タイプ) Then '同じKey(日付か店舗)があれば入力値を計算して古いデータをDictionaryから削除 cnt = Dic.Item(集計タイプ)(1) + 1 合計 = データ + Dic.Item(集計タイプ)(0) 平均 = 合計 / cnt Dic.Remove 集計タイプ Else cnt = 1 合計 = データ End If Dic.Add 集計タイプ, Array(合計, cnt, 平均) End Property あと標準モジュールの方もNext iのところはNext cでした。 （ 'ふ'） 2023/05/10(水) 15:33:59 ---- （ 'ふ'）さん、ありがとうございます。 Debug.Print でちゃんと値を確認しました。 ( ∩_∩)_旦 オチャドウゾー ＞Classモジュールの方はやっぱりこっちで ツーたいぷあるんですね。両方してみます。 コンパクトな設計ですね。 お勉強材料が増えて嬉しいです。Σd(ゝ∀・)ァリガトォ♪ ちょっと、Removeメソッドくんのお勉強をしてきます。 [図書館] λ…………トボトボ （あみな） 2023/05/10(水) 15:36:51 ---- （´・ω・`）さん 既に書きましたが、能力的について行けない状態であります。 なので、（´・ω・`）さんがあれこれ書いた案を一つひとつ理解しておりません。 ただ、能力だけの問題なのかと言うと、図々しくも疑問に思っています。 つまり、本質的に訳が分からない話なら、そもそも理解できないのも当然なので。 ＞クラスの勉強のためっていうことなので、 ＞最初から手段が目的化してるんだなって思ってました 私も同じ解釈です。なので、こう言うテクニカルな課題を論ずるトピックではないと思うのです。 ↓ ＞重複した場合の処理を、どうしたら良いか解らないので ＞ クラスの勉強しますっていってる人に、 ＞ もっといい方法があるのでその勉強はやめなさいって言うのが正義だと ＞ 半平太さんは、そういうことを言ってるのでしょうか? クラスの勉強なんだから、オブジェクト指向らしい考え方が必要と言う趣旨ではあります。 強引にクラスを作って、はいクラスを利用しましたと言ったって始まらないです。 私の考え方は既に書きましたが、こんな考え方が普通じゃないですか、と言っているんですけど。 ＞店舗クラスを作るんだろうな。 ＞そのクラスに、日別来店客数、日別売上、平均来店客数、平均購入単価の各プロパティを持たせたらいいかな。 ＞標準モジュールでそれらインスタンスを操作して結果を出させればいいんだろうな。 他の考え方もあるでしょうが「何をオブジェクトに仕立てるか」がセンスが問われるところです。 オブジェクトなんて訳の分からない用語が使われていますが、 私なら「何を人や会社やモノに見立てるか」です。 私がクラスを使いたいと思う時は、複雑な事例を社会現象に擬制して、 できるだけ自分の理解しやすい世界を構築して、簡明に処理したいと思った時です。 この例であれば、クラスは「各店」さん くらいなものでしょう。 全店の集計をそれ専用のクラスでやらせることは先ずない。 ただし、各店を取りまとめる役割部署に関東本部とか関西本部とか複数あるなら、 各店クラスをプロパティに持つ本部クラスを作ることは考えられる。 （半平太） 2023/05/10(水) 15:51:47 ---- 半平太さんの考えに同意します ので、半平太さん回答してあげてください （´・ω・`） 2023/05/10(水) 16:35:53 ---- 半平太さんの意見に同意なんですが ＞ この例であれば、クラスは「各店」さん くらいなものでしょう。 ＞ 全店の集計をそれ専用のクラスでやらせることは先ずない。 日付で集計したい部分は、一度「各店」さんから日付別データを取り出して、 メインプロシジャで集計するような形ですか? それとも本部クラスに集計させて、値を取り出す感じですか? どちらにしろ、今回の事例は無理やりクラス化するには不適なんだろうなぁという感想ではありますが・・・。 （稲葉） 2023/05/10(水) 16:52:32 ---- （稲葉）さんへ ＞どうせ勉強するなら、白茶さんのコードそのままお借りして、 ＞クラスでイベントを拾う方法勉強されてもいいかもしれないです! この時に、白茶さんが提示してくださったコードを 即、実行して遊びました。(〃∇〃)ゞエヘヘ ＞この部分をクラスにしてコールバックすることで疑似配列が作れて、変数宣言しなくても使えるので ‾‾‾‾‾‾‾‾ ‾‾‾‾‾‾ ＞メインのプロシジャのコーティングを楽にできますよ *コールバック ? ? ? : コンピュータプログラム中で、ある関数などを呼び出す際に別の関数などを途中で実行するよう指定する手法 WithEvents くんなら、ちょこっと解ります。 *疑似配列 ? ? ? : VBAで使われているコーディング手法の「 擬似コントロール配列 」 の事??? 配列超苦手..(〃∇〃)ゞエヘヘ (-ω-;)ウーン…私で出来るかしら? それとも…これは、もしかして（稲葉）さんにお願いしたら ご指導を頂けるってことですか?(。-∀-)ニヤニヤ それともそれとも、（白茶）さんに、オネダリして作って貰う作戦に しなさいって事でしょうか?ブッ( ﾟ∀ﾟ))、;'.・ブハ （あみな） 2023/05/10(水) 16:57:22 ---- ＞ツーたいぷあるんですね。両方してみます。 2タイプというか、連想配列に使うキーの被りが日付と店舗でないので ワザワザ連想配列をふたつに分ける必要はないかな、と思った次第です。 あと必要なデータを取り出して日付と店舗の配列にするコードを組んでみましたが、 このやり方はあまりそれに向かない感じがします。 なのでもう少し考えてみたいと思います。 （ 'ふ'） 2023/05/10(水) 17:07:00 ---- （ 'ふ'）さん、ありがとうございます。 ＞ Classモジュールの方はやっぱりこっちで こちらも、無事に Debug.Print で値を確認しました。 ＞なのでもう少し考えてみたいと思います。 。∠(*^∇ﾟ)ノ⌒ また、覗きにきてください。 よろしく、お願いします。(o_ _)o （あみな） 2023/05/10(水) 17:22:26 ---- 色々書き方あると思いますけど・・・ http://addinbox.sakura.ne.jp/Breakthrough_P-Ctrl_Arrays.htm ↑で勉強してきた中で、隠ぺいとかRaiseEventとかすっとばして、一番簡単（たぶん）に イベントを配列にする方法としての一例です。 UserFormの汎用性の一点においては、こちらをダウンロードして使わせていただくのが一番です。 AddinBox 角田さんに感謝。 ■クラスモジュール（clsCallBack） Option Explicit 'clsCallBack 'イベントをフックするモジュールレベル変数 Private WithEvents cb As msforms.combobox 'CallBack先の情報 Private ProcName_ As String Private SetObject_ As Object Private ID_ As Long 'イベントをフックするオブジェクトを取得 Property Set SetCombobox(cbbox As msforms.combobox) Set cb = cbbox End Property 'CallBack先のオブジェクトとプロシジャ名とIDやら名前やらをセットする Property Let SetCallBackProcName(SetObject As Object, procName As String, ID As Long) ProcName_ = procName Set SetObject_ = SetObject ID_ = ID End Property 'フックしたイベントをCallByNameで↑に登録したオブジェクトとプロシジャを呼び出す Private Sub cb_Change() CallByName SetObject_, ProcName_, VbMethod, "Change", ID_ '‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾‾ 'ここまで定型文 ' ‾‾‾‾‾‾‾‾‾‾‾‾‾ ' これ以降は、ParamArrayなので、ほしい情報だけ入れる。但し、受取側も同じ数だけ引数を準備するか、ParamArrayで受け取る End Sub 'イベントを複数入れることも可能。但し、どのイベントが発生したかはわからないので、CallBack先に伝える必要がある。 Private Sub cb_Click() CallByName SetObject_, ProcName_, VbMethod, "Click", ID_ End Sub ■UserForm（名称は何でもいい） Option Explicit Private clsCB() As clsCallBK Private Sub UserForm_Initialize() Dim i As Long Randomize For i = 0 To 4 With Me.Controls.Add("Forms.ComboBox.1", i) .Left = 10 .Height = 20 .Top = i * .Height + 10 .Width = 50 .AddItem Rnd * 10 .AddItem Rnd * 10 .AddItem Rnd * 10 End With ReDim Preserve clsCB(i) Set clsCB(i) = New clsCallBK With clsCB(i) Set .SetCombobox = Me.Controls(i) .SetCallBackProcName(Me, "CallBackProc") = i End With ' ‾‾‾‾‾‾‾‾‾‾‾‾‾‾ここの登録が↓のプロシジャ名と一致するようにする Next i End Sub 'Publicで宣言しないと、CallBackできない Public Sub CallBackProc(EventName As String, i As Long) MsgBox "発生したイベントは" & EventName & Chr(10) _ & "コントロールIDは" & i & "です" End Sub （稲葉） 2023/05/10(水) 17:52:51 ---- ※閲覧にあたりまして、注意事項がございます。 ( 当コーナー ) 質問掲示板の内容は、 2023/05/10(水) 17:52:51 より、一時的に 別の内容となっておりますので、ご注意ください。 AddinBox 角田さんに感謝(o_ _)o （あみな） 2023/05/10(水) 19:04:09 ---- （稲葉）さん、Help me! ここから、教えてください。^^; ‾‾‾‾‾‾‾‾‾‾‾‾‾‾ここの登録が↓のプロシジャ名と一致するようにする Call CallBackProc(i) 〜 略 〜 End sub '********************* Private Sub CallBackProc1_Change() Dim myData Dim lRow As Long Dim MyCol As Long Dim i As Long Const START_ROW = 2& Const START_COL = 1& For i = 1 To 4 MyCol = START_COL + i - 1 With Worksheets("Sheet1") lRow = .Cells(.Rows.Count, MyCol).End(xlUp).Row If lRow >= START_ROW Then myData = .Range(.Cells(START_ROW, MyCol), .Cells(lRow, MyCol)).Value If Not IsArray(myData) Then myData = Array(myData) With UserForm1.Controls("ComboBox" & i) .List = myData .ListIndex = 0 End With End If End With Next i End Sub End Sub ※Cmbも、久しぶりであまり覚えてないです。 動かない( ;∀;) （あみな） 2023/05/10(水) 20:36:30 ---- 多分全然わかってない感じだから、まず提示した基本のコードにdebug.printつけて、どんな順番で動いてるか確認されては? （稲葉） 2023/05/10(水) 20:51:41 ---- (*・ω・)/ハーイ （あみな） 2023/05/10(水) 20:57:26 ---- debug.printつけて、動きを...と前に ↓ここでコンパイルエラーになってしまします。 Private clsCB() As clsCallBK ^^; （あみな） 2023/05/10(水) 21:18:58 ---- あ、クラスのオブジェクト名間違えてたんで、オブジェクト名をコードに合わせて貰えますか? （稲葉） 2023/05/10(水) 21:28:31 ---- キタワァ━━━ﾟ(∀)ﾟ━━━!! まだ、良く解ってませんが Rnd * 10 くん活動中... （あみな） 2023/05/10(水) 21:35:57 ---- う〜ん、なるほどです。...なんとなくですが^^; Cmb くんを選択すると、配列 0 〜 4 を返して くれるんですね。 （あみな） 2023/05/10(水) 21:50:35 ---- Set clsCB(i) = New clsCallBK ここで New してるんで 好きなだけ、cmb 作れるって事ですね。 明日、もうちょっと遊んでみます o(*'▽'*)/ （あみな） 2023/05/10(水) 21:56:53 ---- ＞Cmb くんを選択すると、配列 0 〜 4 を返して 違います クラスにイベントをフックさせることで、 本来できないイベントを持ったコントロールの配列が可能になったことがこのコードの趣旨です。 試しにクラスなしで同じことを実装しようとしてください。 private Withevents cbs(5) as msforms.combobox こういう実装が出来ないので、クラスを使わない場合 private Withevents cbs0 as msforms.combobox private Withevents cbs1 as msforms.combobox private Withevents cbs2 as msforms.combobox private Withevents cbs3 as msforms.combobox private Withevents cbs4 as msforms.combobox private Withevents cbs5 as msforms.combobox と宣言して、それぞれにイベントプロシジャが必要でした。 Sub cbs0_change() Msgbox 0 End sub Sub cbs1_change() Msgbox 1 End sub 以下略 クラスを使うことで簡単に書くことが出来るということが、 リンク先の§を読み進めていけば理解できると思います。 （稲葉） 2023/05/10(水) 22:08:08 ---- ＞クラスを使うことで簡単に書くことが出来るということが、 ＞リンク先の§を読み進めていけば理解できると思います。 明日、角田さんところを覗いて 【 コントロール配列 】のお勉強をして来ます。o(*'▽'*)/ （あみな） 2023/05/10(水) 22:44:35 ---- 無理やり同意させてしまったような・・、実例を示せと言われているような・・ ＞ 日付で集計したい部分は、一度「各店」さんから日付別データを取り出して、 ＞ メインプロシジャで集計するような形ですか? ＞ それとも本部クラスに集計させて、値を取り出す感じですか? 論旨はメインプロシジャでの集計ですが、仮定として地域本部が複数あって (ただし、今回は関東本部だけ処理する）と言う状況であれば、 本部クラスを作るのは違和感ないです。 その想定の方が質問者さんの意向に合っててサンプルとしてはいいかも知れない。 逆にそんな状況なら、店舗クラスを作る必要性が薄れる。 そんなにコマ切れなクラスを作る必要性が余りないですからねぇ・・ 店舗クラスがもっと複雑な機能を求められているなら話は別なんですけども。 まぁ、そんなことを言うと、そもそもクラスが必要な案件なの? って話に戻るので止めます。 大まかな構造を以下としました。 1.標準モジュールで.地域本部クラスを作成して、その配下の店舗を明確にする。 本部クラスから全店統計データを受け取って、シートに表示する。 2.本部クラスは、配下の店舗クラスに各店の統計データを提出させて、全店集計をする。 3.店舗クラスは、本部クラスの命に従って、自店のデータを提出する ※期間指定はコード内でやっています。(実際は、動的に指定できるようにすべき） ---店舗クラス(Shop)--- Private Enum srcPos 日付 = 1 店舗名 来客数 売上 End Enum Private cName As String Property Let Name(NM As String) cName = NM End Property Property Get Name() As String Name = cName End Property Function salesDataByday(r As Range) Dim App As Application Dim retAry() Dim aRow As Range Dim Pos Dim num Set App = Application ReDim retAry(0 To 0) retAry(0) = Array(0, Empty, 0, 0) num = Application.CountIf(r.Columns("B"), cName) If num > 0 Then For Each aRow In r.Rows If aRow.Cells(1, 店舗名) = cName Then Pos = Pos + 1 ReDim Preserve retAry(0 To Pos) retAry(Pos) = Array(aRow.Cells(1, 日付).Value, aRow.Cells(1, 店舗名).Value, _ aRow.Cells(1, 来客数).Value, aRow.Cells(1, 売上).Value) End If Next End If salesDataByday = retAry End Function ---本部クラス(HQ)--- Private Name Private Shops() As Shop Private ShopNames Private resultByDay() Private resultByShop() Property Let RegionalName(NM As String) Name = NM End Property Sub AddBranch(strBr As String) ' "渋谷店,新宿店,原宿店" Dim i As Long ShopNames = Split(strBr, ",") ReDim Shops(1 To UBound(ShopNames) + 1) For i = 1 To UBound(ShopNames) + 1 '初期値セット Set Shops(i) = New Shop Shops(i).Name = ShopNames(i - 1) Next End Sub Property Get 日付Tbl(ckDays) '設定期間テーブル Dim i As Long Dim DaysAry() ReDim DaysAry(1 To ckDays(1) - ckDays(0) + 1, 1 To 1) 'Array(#5/1/2023#, #5/3/2023#) For i = 1 To UBound(DaysAry) '日付配列セット DaysAry(i, 1) = CLng(ckDays(0)) + i - 1 Next 日付Tbl = DaysAry End Property Property Get 日付別Info(Scope As Range, ckDays) Dim App As Application Dim i As Long, k As Long Dim DaysAry() '日付テーブル Dim dataByday Dim Pos Dim cnt As Long Set App = Application DaysAry = 日付Tbl(ckDays) ReDim resultByDay(1 To UBound(DaysAry), 1 To 2) '日別 For i = 1 To UBound(Shops) '店舗の数だけ繰り返す cnt = 0 ReDim custNsalseAry(1 To UBound(DaysAry), 1 To 2) dataByday = Shops(i).salesDataByday(Scope) '日付/客数/売上を取得 For k = 0 To UBound(dataByday) Pos = App.Match(CLng(dataByday(k)(0)), DaysAry, 0) If IsNumeric(Pos) Then '指定期間内の場合 resultByDay(Pos, 1) = resultByDay(Pos, 1) + dataByday(k)(2) resultByDay(Pos, 2) = resultByDay(Pos, 2) + dataByday(k)(3) End If Next k Next i 日付別Info = resultByDay End Property Property Get 店舗別Stats(Scope As Range, ckDays) Dim App As Application Dim DaysAry() '日付テーブル Dim dataByday Dim Pos Dim cnt As Long, i As Long, k As Long Set App = Application DaysAry = 日付Tbl(ckDays) ReDim resultByShop(1 To UBound(Shops), 1 To 3) '店舗別 For i = 1 To UBound(Shops) '店舗の数だけ繰り返す cnt = 0 ReDim custNsalseAry(1 To UBound(DaysAry), 1 To 2) dataByday = Shops(i).salesDataByday(Scope) '日付/客数/売上を取得 For k = 0 To UBound(dataByday) Pos = App.Match(CLng(dataByday(k)(0)), DaysAry, 0) If IsNumeric(Pos) Then '指定期間内データのみ処理 resultByShop(i, 2) = resultByShop(i, 2) + dataByday(k)(2) resultByShop(i, 3) = resultByShop(i, 3) + dataByday(k)(3) cnt = cnt + 1 '件数 End If Next k resultByShop(i, 1) = Shops(i).Name If cnt > 0 Then resultByShop(i, 3) = resultByShop(i, 3) / resultByShop(i, 2) resultByShop(i, 2) = resultByShop(i, 2) / cnt End If Next i 店舗別Stats = resultByShop End Property ---標準モジュール--- Sub Main() Dim HQs(1 To 1) As HQ '実際は1個だけ Dim Scope As Range '元データ Dim DateTble Dim InfoByDate Dim InfoByShop Dim ckDays ' 指定期間 Set HQs(1) = New HQ HQs(1).RegionalName = "関東本部" HQs(1).AddBranch "渋谷店,新宿店,原宿店" '地域本部に配下となる店舗を追加する ckDays = Array(#5/1/2023#, #5/5/2023#) '取り敢えずプログラム内期間指定 Set Scope = Range("D2", Cells(Rows.Count, "A").End(xlUp)) DateTble = HQs(1).日付Tbl(ckDays) InfoByDate = HQs(1).日付別Info(Scope, ckDays) InfoByShop = HQs(1).店舗別Stats(Scope, ckDays) Range("F2").Resize(UBound(DateTble), 1) = DateTble Range("G2").Resize(UBound(InfoByDate), 2) = InfoByDate Range("J2").Resize(UBound(InfoByShop), 3) = InfoByShop End Sub （半平太） 2023/05/11(木) 08:57:31 ---- ・*•(*・ω・*).•* 皆様...オハヨウゴザイマス♪¨* ( ∩_∩)_旦 オチャドウゾー...(半平太)さん、ありがとうございます。 ＞大まかな構造を以下としました。 実際の業務を、忠実に再現をした構成イメージでしょうか? スラスラ読める実力が無いので、解読に時間がかかりますが 頑張ってします。٩( 'ω' )و ちょっと、 [宿題]が多すぎてヤバい。 λ…………トボトボ （あみな） 2023/05/11(木) 10:48:33 ---- [宿題] 完成ヾ(_ _)〃 クラスモジュールで、コンボボックスのオブジェクトを自動配置し 本来できないイベントを持った、コントロールの配列を可能にする。 ※遠足の( おやつ )選定リスト : Sheet1 |[A] |[B] |[C] [1]|ポケットサイズ|スナック菓子 |チョコレート系 [2]|ガム |チップスター |チロルチョコ [3]|飴 |じゃがりこ |チョコバット [4]|グミ |うまい棒 |コアラのマーチ [5]|ラムネ |かっぱえびせん|パックンチョ ' ----- ThisWorkbook ----- Private Sub Workbook_Open() Worksheets(1).Activate Call ShEv_EventGet End Sub '----- UserForm Module ----- Private clsCB() As clsCallBK Private Sub UserForm_Initialize() Dim myData, data Dim i&, LastRow As Long, LastCol As Long Const Start_Row = 2&, Start_CoL = 1& For i = 0 To 2 LastCol = Start_CoL + i With Worksheets("Sheet1") LastRow = .Cells(.Rows.Count, LastCol).End(xlUp).Row If LastRow >= Start_Row Then myData = .Range(.Cells(Start_Row, LastCol), .Cells(LastRow, LastCol)).Value If Not IsArray(myData) Then myData = Array(myData) With Me.Controls.Add("Forms.ComboBox.1", i) .Left = 10: .Height = 20: .Top = i * .Height + 10: .Width = 80 .List = myData .ListIndex = -1 '' 初期値選択 : 空白 End With ReDim Preserve clsCB(i) Set clsCB(i) = New clsCallBK With clsCB(i) Set .SetCombobox = Me.Controls(i) .SetCallBackProcName(Me, "CallBackProc") = i End With End If End With Next i End Sub Public Sub CallBackProc(EventName As String, i As Long) MsgBox "発生したイベントは " & EventName & Chr(10) _ & "コントロールIDは " & i & "です" Dim v& Debug.Print "ID : " & i v = Me.Controls(i).ListIndex Debug.Print "Index : " & v End Sub ' ----- Class Module ( clsCallBK ) ----- Private WithEvents cb As MSForms.ComboBox Private ProcName_ As String Private SetObject_ As Object Private ID_ As Long Property Set SetCombobox(cbbox As MSForms.ComboBox) Set cb = cbbox End Property Property Let SetCallBackProcName(SetObject As Object, procName As String, ID As Long) ProcName_ = procName Set SetObject_ = SetObject ID_ = ID End Property Private Sub cb_Change() CallByName SetObject_, ProcName_, VbMethod, "Change", ID_ End Sub Private Sub cb_Click() CallByName SetObject_, ProcName_, VbMethod, "Click", ID_ End Sub ' ----- Class Module ( JudyAndMary ) ----- Private WithEvents TargetSh As Worksheet Public Property Set TargetSheet(ByVal vObject As Worksheet) Set TargetSh = vObject End Property Private Sub TargetSh_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Dim myForm As Object Dim RetMsg As VbMsgBoxResult Const vbCrlf2 As String = vbCrLf & vbCrLf If Not Intersect(Target, Range("A1:ID1048576")) Is Nothing Then Cancel = True If UserForms.Count = 0 Then UserForm1.Show vbModeless Else RetMsg = MsgBox _ ("既に、フォームは開かれています" & vbCrLf & _ "キャンセルすると、フォームを閉じます" & vbCrlf2 & _ "継続して利用をする場合は、[ OKボタン ]を押してください", _ vbOKCancel, Title:="INFO") End If Select Case RetMsg Case vbOK UserForm1.Show vbModeless Case vbCancel RetMsg = MsgBox(" 開かれているフォームを閉じます" & vbCrlf2 & _ vbOKOnly + vbInformation, Title:="INFO") For Each myForm In UserForms If UserForm1.Name = "UserForm1" Then Unload UserForm1 Next End Select End If End Sub '----- Standard Module ----- Public ShEv(1 To 2) As JudyAndMary Sub OperationForm_Up() UserForm1.Show vbModeless End Sub Sub ShEv_EventGet() Dim i As Long For i = 1 To 1 Set ShEv(i) = New JudyAndMary Set ShEv(i).TargetSheet = ThisWorkbook.Sheets(i) Next End Sub *尚、動作説明については、質問投稿内容では無い事もあり 割愛させていただきます。[休憩] λ…………トボトボ （あみな） 2023/05/11(木) 20:29:51 ---- 練習の意味も込めて、シートモジュールのイベントもクラスに渡すようにしたんでしょうけど・・・ 標準モジュールのモジュールレベル変数に持たせておくのは、いつ消えるかわからないので危ないんじゃないかなぁ。 Thisworkbookモジュールに Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) なんて便利なイベントがあるんだから、わざわざそうする必要はないと思います。 （稲葉） 2023/05/12(金) 08:59:36 ---- ・*•(*・ω・*).•* 皆様...オハヨウゴザイマス♪¨* ＞いつ消えるかわからないので危ないんじゃないかなぁ。 これ、危ない? ...どっかいっちゃうん? それ困るぽォ(-ω-;) ↓無難に、この辺を使用します。 * Workbook_SheetChange * Workbook_SheetBeforeRightClick （あみな） 2023/05/12(金) 09:46:48 ---- 話がコントロール配列に変わっちゃいましたが、当初のものはこんな感じでどうでしょう。 コードの途中で配列の順番が変わっちゃうので、ついでにソート機能も付けてみました。 +++ クラスモジュール +++ Private Dic集計 As Object Public Sub SetDictonary() 'Dictionaryのインスタンス作成 Set Dic集計 = CreateObject("Scripting.Dictionary") End Sub Public Property Get 集計(ByVal 集計タイプ As Variant, ByVal num As Long) As Variant ' If TypeName(集計タイプ) = "Date" Then num = num - 2 集計 = Dic集計.Item(集計タイプ)(num) End Property Public Property Let 集計(ByVal 集計タイプ As Variant, ByVal num As Long, ByVal データ As Variant) ' Dim cnt As Long Dim 合計(0 To 1) As Double Dim 平均(0 To 1) As Double Dim v(0 To 1, 0 To 1) ' If Dic集計.Exists(集計タイプ) Then '同じKey(日付と店舗)があれば入力値を計算して古いデータをDictionaryから削除 合計(0) = Dic集計.Item(集計タイプ)(0) 合計(1) = Dic集計.Item(集計タイプ)(1) 平均(0) = Dic集計.Item(集計タイプ)(2) 平均(1) = Dic集計.Item(集計タイプ)(3) cnt = Dic集計.Item(集計タイプ)(4) + 1 合計(num) = データ + Dic集計.Item(集計タイプ)(num) 平均(num) = 合計(num) / cnt Dic集計.Remove 集計タイプ Else '初期入力 cnt = 1 合計(num) = データ 平均(num) = データ End If Dic集計.Add 集計タイプ, Array(合計(0), 合計(1), 平均(0), 平均(1), cnt) End Property Public Function ソート番号(ByVal v As Variant, ByVal キー As Variant, _ Optional ByVal 順 As Boolean = True) As Long '集計タイプが昇順/降順で配列内の何番目かを数値で返す '昇順:True,降順:False Dim rnk As Long Dim k As Variant rnk = 1 For Each k In v Select Case キー Case Is < k: If Not 順 Then rnk = rnk + 1 Case Is > k: If 順 Then rnk = rnk + 1 Case Else End Select Next k ソート番号 = rnk End Function +++ 標準モジュール +++ Sub Sample() 'クラスのインスタンス作成 Dim cls集計(0 To 1) As Class1 Set cls集計(0) = New Class1 '日付用 Set cls集計(1) = New Class1 '店舗用 '集計Property用Dictionaryのインスタンス作成 cls集計(0).SetDictonary cls集計(1).SetDictonary 'Key並べ替え用Dictionaryのインスタンス作成 Dim DicKeys(0 To 1) As Object Set DicKeys(0) = CreateObject("Scripting.Dictionary") Set DicKeys(1) = CreateObject("Scripting.Dictionary") '全データを配列に格納 Dim ws As Worksheet Dim ListRange As Range Dim v As Variant Set ws = Worksheets(1) Set ListRange = ws.Range(ws.Cells(2, 1), ws.Cells(ws.Cells(ws.Rows.Count, "A").End(xlUp).Row, "D")) v = ListRange.Value '集計データの出入力と貼り付け Dim i As Long, r As Long, c As Long Dim DicKey As Variant, k As Variant, 配列 As Variant For i = 0 To 1 '入力 For r = 1 To UBound(v, 1) cls集計(i).集計(v(r, i + 1), 0) = v(r, 3) '来店客数 cls集計(i).集計(v(r, i + 1), 1) = v(r, 4) '日別売上 If Not DicKeys(i).Exists(v(r, i + 1)) Then DicKeys(i).Add v(r, i + 1), 0 'キーデータ Next r '昇順/降順でソート If i = 0 Then ReDim DicKey(1 To DicKeys(i).Count, 0 To 1) For Each k In DicKeys(i).Keys DicKey(cls集計(i).ソート番号(DicKeys(i).Keys, k, (i + 1) Mod 2), i) = k Next k '出力 ReDim 配列(1 To UBound(DicKey, 1), 1 To 3) For r = 1 To UBound(DicKey, 1) 配列(r, 1) = DicKey(r, i) For c = 2 To 3 配列(r, c) = cls集計(i).集計(DicKey(r, i), c) Next c Next r '貼付 Dim 始点 As Range, 終点 As Range Set 始点 = ws.Cells(2, "F").Offset(0, i * 4) Set 終点 = ws.Cells(UBound(DicKey, 1) + 1, "H").Offset(0, i * 4) ws.Range(始点, 終点).Value = 配列 Next i End Sub （ 'ふ'） 2023/05/12(金) 12:15:28 ---- 訂正 Public Function ソート番号(ByVal v As Variant, ByVal キー As Variant, _ Optional ByVal 順 As Boolean = True) As Long 'キーが昇順/降順で配列内の何番目かを数値で返す ↑ （ 'ふ'） 2023/05/12(金) 12:34:45 ---- （ 'ふ'）さん、ありがとうございます。  ( -ω-) _旦COFFEEドゾォ...15時なので...┌iii┐ケーキもどうぞ♪ ＞話がコントロール配列に変わっちゃいましたが、当初のものはこんな感じでどうでしょう。 コントロール配列の件は、（あみな） 2023/05/10(水) 13:24:55 の流れから （稲葉）さんが、勉強しときなさいと宿題をくれたのです。 だから、本来の質問投稿内容に戻って全く問題ありません。 今、マクロを実行したばかりなので原因不明ですが 左の表の数値は、他の方と同じ結果ですが、右側が下記になりますぽォ |[J] |[K] |[L] [1]|店舗名|来店客数(平均)|購入単価(平均) [2]|渋谷店| 35.8| 116666.6667 [3]|新宿店| 37.6| 116666.6667 [4]|原宿店| 35.2| 116666.6667 ※他の方は、こうなる方が多いです。 ↓ |[J] |[K] |[L] [1]|店舗名|来店客数(平均)|購入単価(平均) [2]|渋谷店| 59.66666667| 3910.614525 [3]|新宿店| 62.66666667| 3723.404255 [4]|原宿店| 58.66666667| 3977.272727 マクロは、とても見やすいので好きな感じです。 宜しくお願います。*_ _))ペコ （あみな） 2023/05/12(金) 14:59:38 ---- すみません、カウントと平均の計算方法が違っていました。 平均って見ただけで全ての平均と思い込んでいました・・・ ちゃんと見ないとダメですね・・・ 修正したので、Letの方はこれでお願いします。 Public Property Let 集計(ByVal 集計タイプ As Variant, ByVal num As Long, ByVal データ As Variant) ' Dim cnt As Long Dim 合計(0 To 1) As Double Dim 平均(0 To 1) As Double Dim v(0 To 1, 0 To 1) ' If Dic集計.Exists(集計タイプ) Then '同じKey(日付と店舗)があれば入力値を計算して古いデータをDictionaryから削除 合計(0) = Dic集計.Item(集計タイプ)(0) 合計(1) = Dic集計.Item(集計タイプ)(1) cnt = Dic集計.Item(集計タイプ)(4) If num = 0 Then cnt = cnt + 1 合計(num) = 合計(num) + データ 平均(0) = 合計(0) / cnt 平均(1) = 合計(1) / 合計(0) Dic集計.Remove 集計タイプ Else '初期入力 cnt = 1 合計(num) = データ 平均(num) = データ End If Dic集計.Add 集計タイプ, Array(合計(0), 合計(1), 平均(0), 平均(1), cnt) End Property （ 'ふ'） 2023/05/12(金) 17:42:32 ---- なんか修正してばかりですが、Letの中に要らない変数ありました。 Dim v(0 To 1, 0 To 1)←コレ、削除してください。 （ 'ふ'） 2023/05/12(金) 17:48:00 ---- （ 'ふ'）さん、ありがとうございます。 ＞なんか修正してばかりですが 全然、大丈夫ですぽォ v(。・・。) 無事に、他の方と同じ結果になりました。 今、マクロを分解して検証をさせて頂いています。 また、覗きに来てください。 '+++ 標準モジュール +++ Sub Sample() 'クラスのインスタンス作成 Dim cls集計(0 To 1) As Class1 Set cls集計(0) = New Class1 '日付用 Set cls集計(1) = New Class1 '店舗用 '集計Property用Dictionaryのインスタンス作成 cls集計(0).SetDictonary cls集計(1).SetDictonary 'Key並べ替え用Dictionaryのインスタンス作成 Dim DicKeys(0 To 1) As Object Set DicKeys(0) = CreateObject("Scripting.Dictionary") Set DicKeys(1) = CreateObject("Scripting.Dictionary") '全データを配列に格納 Dim ws As Worksheet Dim ListRange As Range Dim v As Variant Set ws = Worksheets(1) Set ListRange = ws.Range(ws.Cells(2, 1), ws.Cells(ws.Cells(ws.Rows.Count, "A").End(xlUp).Row, "D")) v = ListRange.Value '集計データの出入力と貼り付け Dim i As Long, r As Long, c As Long Dim DicKey As Variant, k As Variant, 配列 As Variant For i = 0 To 1 Debug.Print "[ 標準M No. i : " & i & " ]" Stop '入力 For r = 1 To UBound(v, 1) cls集計(i).集計(v(r, i + 1), 0) = v(r, 3) '来店客数 cls集計(i).集計(v(r, i + 1), 1) = v(r, 4) '日別売上 Debug.Print "[ 標準M No. r : " & r & " ]" Debug.Print "来店客数 " & v(r, 3) Debug.Print "日別売上 " & v(r, 4) Stop If Not DicKeys(i).Exists(v(r, i + 1)) Then DicKeys(i).Add v(r, i + 1), 0 'キーデータ Debug.Print "Not Exists " & v(r, i + 1) Stop Next r '昇順/降順でソート If i = 0 Then ReDim DicKey(1 To DicKeys(i).Count, 0 To 1) For Each k In DicKeys(i).Keys DicKey(cls集計(i).ソート番号(DicKeys(i).Keys, k, (i + 1) Mod 2), i) = k Next k '出力 ReDim 配列(1 To UBound(DicKey, 1), 1 To 3) For r = 1 To UBound(DicKey, 1) 配列(r, 1) = DicKey(r, i) For c = 2 To 3 配列(r, c) = cls集計(i).集計(DicKey(r, i), c) Next c Next r Stop '貼付 Dim 始点 As Range, 終点 As Range Set 始点 = ws.Cells(2, "F").Offset(0, i * 4) Set 終点 = ws.Cells(UBound(DicKey, 1) + 1, "H").Offset(0, i * 4) ws.Range(始点, 終点).Value = 配列 Next i End Sub '+++ クラスモジュール +++ Private Dic集計 As Object Public Sub SetDictonary() Set Dic集計 = CreateObject("Scripting.Dictionary") End Sub Public Property Get 集計(ByVal 集計タイプ As Variant, ByVal num As Long) As Variant Debug.Print "Get 集計 ---------" Debug.Print "集計タイプ " & 集計タイプ Debug.Print "num " & num Debug.Print "------------------" Stop If TypeName(集計タイプ) = "Date" Then num = num - 2 集計 = Dic集計.Item(集計タイプ)(num) Debug.Print "TypeName Date " & num Debug.Print "集計 " & Dic集計.Item(集計タイプ)(num) Debug.Print "------------------" Stop End Property Public Property Let 集計(ByVal 集計タイプ As Variant, ByVal num As Long, ByVal データ As Variant) Dim cnt As Long Dim 合計(0 To 1) As Double Dim 平均(0 To 1) As Double If Dic集計.Exists(集計タイプ) Then '同じKey(日付と店舗)があれば、入力値を '計算して古いデータをDictionaryから削除 合計(0) = Dic集計.Item(集計タイプ)(0) 合計(1) = Dic集計.Item(集計タイプ)(1) cnt = Dic集計.Item(集計タイプ)(4) Debug.Print "Let 集計 ---------" Debug.Print "合計(0) " & 合計(0) Debug.Print "合計(1) " & 合計(1) Debug.Print "cnt " & cnt Debug.Print "------------------" Stop If num = 0 Then cnt = cnt + 1 合計(num) = 合計(num) + データ 平均(0) = 合計(0) / cnt 平均(1) = 合計(1) / 合計(0) Debug.Print "Let 集計 ---------" & " num = 0" Debug.Print "合計(num) " & 合計(num) Debug.Print "平均(0) " & 平均(0) Debug.Print "平均(1) " & 平均(1) Debug.Print "------------------" Stop Dic集計.Remove 集計タイプ Debug.Print "Remove On" Debug.Print "------------------" Stop Else '初期入力 cnt = 1 合計(num) = データ 平均(num) = データ Debug.Print "合計(num) " & 合計(num) Debug.Print "平均(num) " & 平均(num) Debug.Print "------------------" Stop End If Dic集計.Add 集計タイプ, Array(合計(0), 合計(1), 平均(0), 平均(1), cnt) End Property Public Function ソート番号(ByVal v As Variant, ByVal キー As Variant, _ Optional ByVal 順 As Boolean = True) As Long '集計タイプが昇順/降順で配列内の何番目かを数値で返す '昇順:True,降順:False Dim rnk As Long Dim k As Variant rnk = 1 For Each k In v Select Case キー Case Is < k: If Not 順 Then rnk = rnk + 1 Case Is > k: If 順 Then rnk = rnk + 1 Case Else End Select Next k ソート番号 = rnk End Function [分解]...ニヒヒ (*´˘`*) （あみな） 2023/05/12(金) 21:29:05 ---- ころころ変更してやっていますけど。 いつまで続くことやら。 （なみあ） 2023/05/12(金) 22:09:37 ---- ↑名乗れない方へ 興味がある人が、閲覧すればよい。 興味がないスレなら、見なければ良い。 違いますか? ただそれだけでしょ （あみな） 2023/05/12(金) 22:34:35 ---- おはよ〜ございます。。。^^ 頑張っておられますね〜(#^^#)頭が下がります。 大先輩の後で、恐縮の極みですが。ちょこっと、お邪魔を [^^;] 普通の関数をまるっと、無理やりクラスモジュールに放り込んで クラスらしく属性を。。。@@; これまた、無理やりくっつけた感じのクラスだす。\(◎o◎)/!ガーン また叱られソぉですが、恐る恐る、こわごわ。。。生徒研究発表出展でぇ〜す 標準モジュール Option Explicit 'シート属性[xP.zk]は1以外はデフォルト、1のみユーザー設定 ^^; Sub aGgregate_Main() Dim xP As aggr Set xP = New aggr xP.zk = 1 xP.myProc MsgBox "シート属性 = " & xP.zokusei End Sub クラスモジュール[ aggr ] Option Explicit Private sflg As Boolean Public zokusei As Long Private Sub Class_Initialize() sflg = False zokusei = 0 If Evaluate("=ISREF(Sheet1!A1)") Then sflg = True End Sub Public Property Let zk(zx As Long) zokusei = zx End Property Public Property Get zk() As Long zk = zokusei End Property Public Sub myProc() If sflg Then Dim v() As Variant Dim w1() As Variant Dim w2() As Variant If dAtaGet(v) = False Then Exit Sub dtReSet v, w1, w2 dWriteToWs w1, w2 Erase v, w1, w2 Else MsgBox "Sheet1が無い可能性が有ります" End If End Sub Private Function dAtaGet(v()) As Boolean dAtaGet = True Dim r As Range With Worksheets("Sheet1") Set r = .Cells(1).CurrentRegion If r.Count < 2 Or r.Rows.Count < 2 Then MsgBox "情報が異常です" dAtaGet = False Exit Function End If Set r = r.Offset(1).Resize(r.Rows.Count - 1) v = r.Value End With End Function Private Sub dtReSet(v(), w1(), w2()) Dim i As Long Dim zD As Object Dim tmp() As Variant Dim x As Variant Set zD = CreateObject("Scripting.Dictionary") For i = 1 To UBound(v, 1) If Not zD.Exists(CLng(v(i, 1))) Then ReDim tmp(1) tmp(0) = v(i, 3) tmp(1) = v(i, 4) Else tmp = zD(CLng(v(i, 1))) tmp(0) = tmp(0) + v(i, 3) tmp(1) = tmp(1) + v(i, 4) End If zD(CLng(v(i, 1))) = tmp Erase tmp Next ReDim w1(1 To zD.Count, 1 To 3) i = 1 For Each x In zD w1(i, 1) = x w1(i, 2) = zD(x)(0) w1(i, 3) = zD(x)(1) i = i + 1 Next zD.RemoveAll Erase tmp For i = 1 To UBound(v, 1) If Not zD.Exists(v(i, 2)) Then ReDim tmp(2) tmp(0) = v(i, 3) tmp(1) = v(i, 4) tmp(2) = 1 Else tmp = zD(v(i, 2)) tmp(0) = tmp(0) + v(i, 3) tmp(1) = tmp(1) + v(i, 4) tmp(2) = tmp(2) + 1 End If zD(v(i, 2)) = tmp Erase tmp Next ReDim w2(1 To zD.Count, 1 To 3) i = 1 For Each x In zD w2(i, 1) = x w2(i, 2) = zD(x)(0) / zD(x)(2) w2(i, 3) = zD(x)(1) / zD(x)(0) i = i + 1 Next zD.RemoveAll Erase tmp End Sub Private Sub dWriteToWs(w1(), w2()) With Worksheets("Sheet1") .[f2].CurrentRegion.Clear .[f2].Resize(UBound(w1, 1), UBound(w1, 2)) = w1 .[j2].CurrentRegion.Clear .[j2].Resize(UBound(w2, 1), UBound(w2, 2)) = w2 If zokusei <> 0 Then With Union(.[f2].CurrentRegion, .[j2].CurrentRegion) .Font.Color = vbWhite .Interior.ColorIndex = 1 End With End If .Columns.AutoFit .Activate End With End Sub Private Sub Class_Terminate() sflg = False End Sub 稲葉先生ご案内の 大域変数問題は、別途、ご勘案[アドイン化等々etc]下さいませ。でわ ↑コード内容くらいですと、消えはしないでせう←多分。。。(￣▽￣;) m(__)m （隠居Z） 2023/05/13(土) 09:20:49 ---- ↑ 追伸^^; シート名 Sheet1 が対象で、 |[A] |[B] |[C] |[D] [1] |日付 |店舗名|来店客数|日別売上 [2] |2023/5/1|渋谷店| 56| 250,000 [3] |2023/5/1|新宿店| 63| 250,000 [4] |2023/5/1|原宿店| 59| 250,000 [5] |2023/5/2|渋谷店| 61| 220,000 [6] |2023/5/2|新宿店| 58| 220,000 [7] |2023/5/2|原宿店| 60| 220,000 [8] |2023/5/3|渋谷店| 62| 230,000 [9] |2023/5/3|新宿店| 67| 230,000 [10]|2023/5/3|原宿店| 57| 230,000 が 存在することが前程です。 解りにくくて、相済みません。m(__)m 追伸の追伸。(*^^*)v ＞＞強引にクラスを作って、はいクラスを利用しましたと ＞＞言ったって始まらないです。 に ほぼ当てはまる内容ですので。↑ゴミ箱ポイしておいてください お騒がせ致しました。引き続き、諸先輩のコードを、こっそり 勉強致します。m(__)m （隠居Z） 2023/05/13(土) 09:32:57 ---- ・*•(*・ω・*).•* 皆様..こんにちわぁ♪¨* ＞また叱られソぉですが、恐る恐る、こわごわ。。。生徒研究発表出展でぇ〜す 隠居Zさまのマクロを見た…10秒後の私の顔は ↓こんな感じ( 決して、爆弾は入っていませんのでご安心を ) https://d.kuku.lu/rm7hgzudt [ アップロード先 : ファイルなう ] https://d.kuku.lu/ [ 運営者情報 : くくさま @kukusama ] https://twitter.com/kukusama （あみな） 2023/05/13(土) 14:51:28 ---- (◎_◎;)。 m(__)mm(__)mm(__)mv (*^ ^*)/// （隠居Z） 2023/05/13(土) 16:14:10 ---- ・*•(*・ω・*).•* 皆様..こんにちわぁ♪¨* 隠居Z さま のマクロの書き方は、どうなのか? 気になって実行する。...うん、順調に動いている。 では、行数を増やして、再テスト!! ちゃんと、動く。。。対応している。(-ω-*)ウン さらに深く追求して、内部処理の状態( メモリ消費量 )を （´・ω・`）さんの、 2023/05/09(火) 09:39:07 のsample2 マクロと比較してみる。 ※準備として Sub SHEET1_MAKE() にてレイアウトを作成後に Sub SHEET1_MAKE2() を実行し、2998行目迄増やす。 Sub SHEET1_MAKE2() '' 2998行目迄作成 Dim i&, n& Application.ScreenUpdating = False For i = 0 To 331 With Sheets(1) .Range("A2:A4") = "2023/05/01" .Range(Cells(11 + n * 9, 2), Cells(19 + n * 9, 4)).Value = _ .Range(Cells(2, 2), Cells(10, 4)).Value With .[A5] '' 日付連続入力 .Formula = "=A2+1" .AutoFill .Resize(2994) End With End With n = n + 1 Next '' 罫線処理 [A1].Resize(2998, 4).Borders.LineStyle = xlContinuous Application.ScreenUpdating = True MsgBox "処理完了" End Sub ※ 結果から *1回目 : 隠居Zs メモリ使用率 : スタート メモリ使用率 : 69% 利用可能メモリ : 2,345MB ---------------- メモリ使用率 : dtReSet : 1 メモリ使用率 : 70% 利用可能メモリ : 2,334MB ---------------- メモリ使用率 : dtReSet : 2 メモリ使用率 : 70% 利用可能メモリ : 2,334MB ---------------- メモリ使用率 : 終了後 メモリ使用率 : 70% 利用可能メモリ : 2,322MB ---------------- *2回目 : 隠居Zs メモリ使用率 : スタート メモリ使用率 : 70% 利用可能メモリ : 2,307MB ---------------- メモリ使用率 : dtReSet : 1 メモリ使用率 : 70% 利用可能メモリ : 2,313MB ---------------- メモリ使用率 : dtReSet : 2 メモリ使用率 : 70% 利用可能メモリ : 2,290MB ---------------- メモリ使用率 : 終了後 メモリ使用率 : 70% 利用可能メモリ : 2,308MB ---------------- *1回目 : （´・ω・`）s メモリ使用率 : スタート メモリ使用率 : 69% 利用可能メモリ : 2,394MB ---------------- メモリ使用率 : 書き出し前 メモリ使用率 : 69% 利用可能メモリ : 2,384MB ---------------- メモリ使用率 : 終了時 メモリ使用率 : 69% 利用可能メモリ : 2,390MB ---------------- *2回目 : （´・ω・`）s メモリ使用率 : スタート メモリ使用率 : 69% 利用可能メモリ : 2,393MB ---------------- メモリ使用率 : 書き出し前 メモリ使用率 : 69% 利用可能メモリ : 2,383MB ---------------- メモリ使用率 : 終了時 メモリ使用率 : 69% 利用可能メモリ : 2,403MB ---------------- テスト環境 '************************************************************** プロセッサ 12th Gen Intel(R) Core(TM) i5-1230U 1.00 GHz 実装 RAM 8.00 GB (7.63 GB 使用可能) システム種類 64 ビット オペレーティング システム、x64 ベース プロセッサ '************************************************************** 両者とも、大きな違いは無いが…（´・ω・`）さんのマクロの方が ほんの僅かではあるが、メモリ消費量が少ないように思いました。 う〜ん…この程度の行数では、解り難いですね。^^; 勿論、隠居Zさまは、練習で遊んで書いたマクロではあるが ひとつの研究課題として処理内容、各メソッドなどが 与える影響など、行数が数万行とさらに増えた場合など どうなるのかを、検討をしていきたいと思いました。 （あみな） 2023/05/14(日) 13:41:27 ---- 隠居Zさまのテスト用、標準モジュール ************************************************************* Sub aGgregate_Main() Debug.Print "メモリ使用率 : スタート" メモリー負荷テスト Debug.Print " ---------------- " Stop Dim xP As aggr Set xP = New aggr xP.zk = 1 xP.myProc MsgBox "シート属性 = " & xP.zokusei Stop Debug.Print "メモリ使用率 : 終了後 " メモリー負荷テスト Debug.Print " ---------------- " Stop End Sub ※クラスモジュールは、zD.RemoveAll の上に ↓下記のように入れてテストしました。 Debug.Print "メモリ使用率 : dtReSet : 1" メモリー負荷テスト Debug.Print " ---------------- " Stop （あみな） 2023/05/14(日) 13:42:53 ---- （´・ω・`）さんのテスト用、マクロについて ************************************************************* 変数名を、日本語化してしまっていますが 内容は同じとなります。 Option Explicit '----- 標準モジュール ----- Sub sample2() '' 2023/05/09(火) 13:03:55 提示分 Dim i&, n& Dim data As clsShopData Dim 日付 As Date, 店名 As String, 客数 As Long, 売上 As Long Set data = New clsShopData Debug.Print "メモリ使用率 : スタート" メモリー負荷テスト Debug.Print " ---------------- " Stop With Sheets(1) For n = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row 日付 = .Cells(n, "A") 店名 = .Cells(n, "B") 客数 = .Cells(n, "C") 売上 = .Cells(n, "D") data.AddRecord 日付, 店名, 客数, 売上 Next Debug.Print "メモリ使用率 : 書き出し前" メモリー負荷テスト Debug.Print " ---------------- " Stop n = 2 For i = 1 To data.DateCount 日付 = data.日付List(i) .Cells(n, "F") = 日付 .Cells(n, "G") = data.全店来店客数(日付) .Cells(n, "H") = data.全店日別売上(日付) n = n + 1 Next n = 2 For i = 1 To data.ShopCount 店名 = data.店別List(i) .Cells(n, "J") = 店名 .Cells(n, "K") = data.来店平均客数(店名) .Cells(n, "L") = data.購入平均単価(店名) n = n + 1 Next MsgBox "処理完了" Stop Debug.Print "メモリ使用率 : 終了時" メモリー負荷テスト Debug.Print " ---------------- " Stop End With End Sub Option Explicit '--------- clsShopData --------- Private x日別客数 As Dictionary Private x日別売上 As Dictionary Private x店別客数 As Dictionary Private x店別売上 As Dictionary Private Sub Class_Initialize() Set x日別客数 = New Dictionary Set x日別売上 = New Dictionary Set x店別客数 = New Dictionary Set x店別売上 = New Dictionary End Sub Public Sub AddRecord(日付, 店名, 客数, 売上) Me.客数(日付, 店名) = 客数 Me.売上(日付, 店名) = 売上 End Sub Public Property Let 客数(Optional ByVal 日付 As Date, Optional ByVal 店名 As String, v客数 As Long) If x日別客数.Exists(日付) Then x日別客数(日付) = x日別客数(日付) + v客数 Else x日別客数.Add 日付, v客数 If x店別客数.Exists(店名) Then x店別客数(店名) = x店別客数(店名) + v客数 Else x店別客数.Add 店名, v客数 If Not x日別売上.Exists(日付) Then x日別売上.Add 日付, 0 If Not x店別売上.Exists(店名) Then x店別売上.Add 店名, 0 End Property Public Property Let 売上(Optional ByVal 日付 As Date, Optional ByVal 店名 As String, v売上 As Long) If x日別売上.Exists(日付) Then x日別売上(日付) = x日別売上(日付) + v売上 Else x日別売上.Add 日付, v売上 If x店別売上.Exists(店名) Then x店別売上(店名) = x店別売上(店名) + v売上 Else x店別売上.Add 店名, v売上 If Not x日別客数.Exists(日付) Then x日別客数.Add 日付, 0 If Not x店別客数.Exists(店名) Then x店別客数.Add 店名, 0 End Property Public Property Get 店舗別日別客数(店名) Set 店舗別日別客数 = x店別客数(店名) End Property Public Property Get ShopSales(店名) Set ShopSales = x店別売上(店名) End Property Public Property Get 全店来店客数(日付) 全店来店客数 = x日別客数(日付) End Property Public Property Get 全店日別売上(日付) 全店日別売上 = x日別売上(日付) End Property Public Property Get 日付List(Optional ByVal i) If IsMissing(i) Then 日付List = x日別客数.Keys Else 日付List = x日別客数.Keys(i - 1) End Property Public Property Get 店別List(Optional ByVal i) If IsMissing(i) Then 店別List = x店別客数.Keys Else 店別List = x店別客数.Keys(i - 1) End Property Public Property Get 来店平均客数(日付) 来店平均客数 = x店別客数(日付) / x日別客数.Count End Property Public Property Get 購入平均単価(店名) 購入平均単価 = x店別売上(店名) / x店別客数(店名) End Property Public Property Get DateCount() As Long DateCount = x日別客数.Count End Property Public Property Get ShopCount() As Long ShopCount = x店別客数.Count End Property （あみな） 2023/05/14(日) 13:45:31 ---- メモリ消費量テスト用 '************************************************************* '標準モジュール Option Explicit Private Declare PtrSafe Function GlobalMemoryStatusEx Lib "kernel32" ( _ mseStatus As MEMORYSTATUSEX) As LongPtr Private Type MEMORYSTATUSEX dwLength As Long dwMemoryLoad As Long ullTotalPhys As Currency ullAvailPhys As Currency ullTotalPageFile As Currency ullAvailPageFile As Currency ullTotalVirtual As Currency ullAvailVirtual As Currency ullAvailExtendedVirtual As Currency End Type 'メモリ情報の取得 Sub メモリー負荷テスト() Dim dMemoryLoad As Double Dim dTotPhys As Double Dim dAvailPhys As Double Dim dTotalPageFile As Double Dim dAvailPageFile As Double Dim dTotalVirtual As Double Dim dAvailVirtual As Double Dim MemStat As MEMORYSTATUSEX MemStat.dwLength = Len(MemStat) Call GlobalMemoryStatusEx(MemStat) dMemoryLoad = MemStat.dwMemoryLoad dTotPhys = MemStat.ullTotalPhys * 10000& dAvailPhys = MemStat.ullAvailPhys * 10000& dTotalPageFile = MemStat.ullTotalPageFile dAvailPageFile = MemStat.ullAvailPageFile dTotalVirtual = MemStat.ullTotalVirtual dAvailVirtual = MemStat.ullAvailVirtual dTotalVirtual = MemStat.ullAvailExtendedVirtual 'メモリ情報を出力 Debug.Print "メモリ使用率 : " & dMemoryLoad & "%" Debug.Print "利用可能メモリ : " & Format(dAvailPhys / (1024& * 1024), "#,##0") & "MB" End Sub （あみな） 2023/05/14(日) 13:46:39 ---- 先日書き込みのありました 名乗れない、情けない方のコメントを、遺憾なく思う次第であります。 ご都合主義で名前を変更し投稿する、また、都度違う名前で回答をする。 身バレしないので、辺り構わずどこにでも誹謗中傷する。満足ですか? 決して、今回が初めてではありませんが、このような方が後を絶たない 問題が非常に多いのが、[ エクセルの学校 ]の現状であると思います。 いい大人が、本当に情けない。このような方は、一体ここに何をしに 来ているのでしょうか? エクセルの勉強をする前に、自身の人間性を 先に磨かれよ...と思います。 正直、このような方の子供として...この世に出たくないものです。 決して、このような方の子供として、産み落とされたくはない。 腐敗したこの世がいけないのでしょうか? 断定をしたくはないが でも、でも、もしも産み落とされたらその時は。 その時は...腹が立つとかではなく、もう諦めるしかない。 叫んでも、届かないと思いますが。僅かな、可能性を信じて （あみな） 2023/05/14(日) 13:49:55 ---- 私の質問に、回答を頂だけた方、また応援を頂けた方 本当に、ありがとうございます。 今回のレイアウトによる課題は、（じゃふ）さんの言葉を借りるなら 当たって砕けろ!でしたが、マクロで回答を頂いた方のおかげもあって 少なからず処理としては、可能性を知りました。 まだ、本当はいろいろ聞きたくて、研究を一緒に楽しみたいと 思っておりましたが残念です。心が、痛みました...悲しい現実です。 クラスの事は、他の書籍ないしWebページを参考に 今後も自身の研究テーマを拡大し、学習して参ります。 ありがとうございました。 （あみな） 2023/05/14(日) 13:50:44 ---- こんにちわ。^^ 雑音は聞き流して。。。いただいて..。(*^^*) Let's Enjoy VBA ! Party !! ♪〜 楽しくお勉強させて戴きました。有難う御座いました。^^ でわ、でわ。。。また m(_ _)m （隠居Z） 2023/05/14(日) 14:49:54... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/202305/20230508121022.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97012 documents and 608132 words.
訪問者：