https://excel-ubara.com/excelvba4/EXCEL216.html
https://vba-create.jp/vba-dictionary-item-change/
-- 1. 開発タブの挿入でボタンを作成
※ActiveXコントロールのものを使用する
-- 2. デザインモードONで作成したボタンをダブルクリックするとエディタが開くので下記コードを記載。デザインモードOFFで実行
※ 下記設定必要
「Microsoft Scripting Runtime」の参照設定
Option Explicit
Private Sub CommandButton1_Click()
'テストデータ作成
Range("A1") = "プロジェクト名"
Range("A2") = "PJ01"
Range("A3") = "PJ02"
Range("A4") = "PJ02"
Range("A5") = "PJ03"
Range("A6") = "PJ01"
Range("A7") = "PJ01"
Range("A8") = "PJ02"
Range("A9") = "PJ01"
Range("A10") = "PJ01"
Range("B1") = "種別"
Range("B2") = "TABLE"
Range("B3") = "INDEX"
Range("B4") = "VIEW"
Range("B5") = "TABLE"
Range("B6") = "TABLE"
Range("B7") = "INDEX"
Range("B8") = "VIEW"
Range("B9") = "TABLE"
Range("B10") = "TABLE"
Range("C1") = "名前"
Range("C2") = "T01"
Range("C3") = "I01"
Range("C4") = "V01"
Range("C5") = "T02"
Range("C6") = "T03"
Range("C7") = "I02"
Range("C8") = "V02"
Range("C9") = "T06"
Range("C10") = "T05"
Dim myDic As New Dictionary
Set myDic = Nothing
Dim total As Long
Dim i As Long
Dim k As String
With ThisWorkbook.Sheets("Sheet1")
total = 0
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
k = .Cells(i, 1).Value & "." & .Cells(i, 2).Value
If Not myDic.Exists(k) Then
myDic.Add k, 1
Else
myDic(k) = myDic(k) + 1
End If
total = total + 1
Next i
End With
Dim vKey As Variant
Debug.Print "プロジェクト/種別毎の集計"
For Each vKey In myDic
Debug.Print vKey, myDic(vKey)
Next
'distinct プロジェクト名を取得
Dim myDic2 As New Dictionary
Set myDic2 = Nothing
Dim myArr As Variant
Dim pjmei As String
For Each vKey In myDic
myArr = Split(vKey, ".")
pjmei = myArr(0)
If Not myDic2.Exists(pjmei) Then
myDic2.Add pjmei, myDic(vKey)
Else
myDic2(pjmei) = myDic2(pjmei) + myDic(vKey)
End If
Next
Debug.Print "プロジェクト毎の集計"
For Each vKey In myDic2
Debug.Print vKey, myDic2(vKey)
Next
Debug.Print "TOTAL=" & total
Dim vKey2 As Variant
Dim syubetsu As String
For Each vKey In myDic2
Debug.Print "■" & vKey
For Each vKey2 In myDic
myArr = Split(vKey2, ".")
pjmei = myArr(0)
syubetsu = myArr(1)
If pjmei = vKey Then
Debug.Print syubetsu & " -> " & myDic(vKey2)
End If
Next
Debug.Print ""
Next
End Sub
