Excel VBA質問箱 IV

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

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


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

46970 / 76736

←次へ　｜　前へ→


	【34733】Re:ｶｳﾝﾄ方法について

hatena - 06/2/10(金) 18:21 -


	引用なし

	パスワード

▼ichinose さん：
自分なりに頑張ってみましたが、うまく動きません。
A列　B列とカウントしたいときがあり、このように変えてみました。
っがうまく動きません。どのようにしたら、よろしいでしょうか？
また、今後、C列も増える予定に変更され、AとB列の組合せだけでなく
BとC列の組み合わせもありえるとのことで、変更箇所等を教えてください。
Sub A列()
　　抽出 "A"
End Sub
Sub B列()
　　抽出 "B"
End Sub
Sub 抽出(RowNo As String)
　　Set rng = Range("" & RowNo & "2:" & RowNo & "" & Cells(Rows.Count, 1).End(xlUp).Row & "")

　　If rng.Row > 1 Then
　　　　Set dic = CreateObject("scripting.dictionary")
　　　　With dic
　　　　　　For Each crng In rng
　　　　　　　　If .Exists(CStr(crng.Value)) Then　 .Item(CStr(crng.Value)) = .Item(CStr(crng.Value)) + 1　
Else
　　　　　　　　　　.Add CStr(crng.Value), 1　　　　　　　　　　　　　　　
　　　　　　　　End If
　　　　　　Next
　　　　　　　　　　　　
　　　　　　Cells(rng.Count + 2, RowNo).Value = Cells(1, RowNo).Value
　　　　　　Range(Cells(rng.Count + 3, RowNo), Cells(rng.Count + 2 + .Count, RowNo)).Value = Application.Transpose(.Keys)
　　　　　　Range(Cells(rng.Count + 3, RowNo), Cells(rng.Count + 2 + .Count, 2)).Value = Application.Transpose(.Items)
　　　　　　Range(Cells(rng.Count + 3, RowNo), Cells(rng.Count + 3 + .Count, 2)).Sort Key1:=Cells(rng.Count + 3, 1), Order1:=xlAscending, Header:=xlNo
　　　　　　End With
　　　　Set dic = Nothing
　　End If
End Sub

0 hits

▼

【34650】ｶｳﾝﾄ方法について hatena 06/2/9(木) 10:47