| |
▼こまつ さん：
別法で、連想配列で仕分けしておいて、結果の配列だけをシートに値転記
する方法です。（つまり、シートに数式を埋め込んでいません）
Sub Try1() 'by dictionary
Dim aryDate
Dim aryKind
Dim r As Range
Dim dic As Object
Dim ss As String, sDate As String
Dim i As Long, j As Long
Dim xx As Long
Const yy = 5 'A,B,C,D,E 5種類
'元データを配列に格納
Set r = Range("D8", Cells(Rows.Count, "D").End(xlUp))
aryDate = Application.Text(r, "mmdd")
aryKind = r.Offset(, Asc("I") - Asc("D")).Value
Set dic = CreateObject("Scripting.Dictionary")
'D列＋I列 を結合したキーで出現回数カウント
For i = 1 To UBound(aryDate)
ss = aryDate(i, 1) & aryKind(i, 1)
dic(ss) = dic(ss) + 1
Next
'カウント結果を配列に出力
Dim Kinds, Dates
Kinds = Range("C2").Resize(yy).Value
Dates = Application.Text( _
Range("D1", Cells(1, Columns.Count).End(xlToLeft)), _
"mmdd")
xx = UBound(Dates)
ReDim Ans(1 To yy, 1 To xx)
For j = 1 To xx
For i = 1 To yy
ss = Dates(j) & Kinds(i, 1)
If dic.Exists(ss) Then
Ans(i, j) = dic(ss)
End If
Next
Next
Set dic = Nothing
'結果をシートに出力
Range("D2").Resize(yy, xx).Value = Ans
MsgBox "完了"
End Sub
|
|
kanabun
- 09/3/4(水) 12:12 -
