Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

21525 / 76732

←次へ　｜　前へ→


	【60602】Re:CountIFで集計したい

kanabun - 09/3/4(水) 12:12 -


	引用なし

	パスワード

▼こまつさん：

別法で、連想配列で仕分けしておいて、結果の配列だけをシートに値転記
する方法です。（つまり、シートに数式を埋め込んでいません）

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

0 hits

▼

【60577】CountIFで集計したい nokubo 09/3/3(火) 14:08