集計表をダブルクリックすると内訳を表示するようにしてみた(コード編)

以前にこの様な記事を公開した。

www.excellovers.com

どうやら実現できてヒャッハーと報告しただけで終わっていたようなので、今更ながらコードの紹介。

完成品
コード
- 集計表があるシートのイベント
- 標準モジュール
シートイベント
標準モジュール(DoubleClickDataReport)
まとめ

完成品

以前とほぼ同じだが、このような元データを用意した。
f:id:ExcelLover:20210522171144j:plain

これをこのように集計している。
f:id:ExcelLover:20210522171204j:plain

この集計データの詳細を見たい箇所をダブルクリックすると。
f:id:ExcelLover:20210522171307g:plain

このように元データが表示される。

コード

集計表があるシートのイベント

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     
     If Not Intersect(Range("B2:C4"), Target) Is Nothing Then
          Dim CurryType As String: CurryType = Target.End(xlToLeft).Value
          Dim YearMonth As String: YearMonth = Format(Target.End(xlUp).Value, "yyyymm")
          
          DoubleClickDataReport CurryType, YearMonth
     End If
End Sub

標準モジュール

Sub DoubleClickDataReport(CurryType As String, YearMonth As String)
'参照設定でMicrosoft Active X Data Objects XX Libraryを設定
     Dim myCON As ADODB.Connection: Set myCON = New ADODB.Connection
     myCON.Provider = "Microsoft.ACE.OLEDB.12.0"
     myCON.Properties("Extended Properties") = "Excel 12.0;IMEX=1"
     
     myCON.Open ThisWorkbook.FullName
     
     Dim myRS As ADODB.Recordset: Set myRS = New ADODB.Recordset
     Dim mySQL As String
     
     mySQL = "select * from [Data$] where カレー = '" & CurryType & "' and "
     mySQL = mySQL & "format(日付,'yyyymm') = " & YearMonth
     myRS.Open mySQL, myCON, adOpenStatic
     
     Dim myWB As Workbook: Set myWB = Workbooks.Add
     Dim myWS As Worksheet: Set myWS = myWB.Worksheets(1)
     myWS.Range("A:A").NumberFormatLocal = "yyyy/mm/dd"
     Dim i As Long
     For i = 1 To myRS.Fields.Count
          myWS.Cells(1, i).Value = myRS.Fields(i - 1).Name
     Next
     myWS.Range("A2").CopyFromRecordset myRS
     myRS.Close
     Set myRS = Nothing
     myCON.Close
     Set myCON = Nothing
End Sub