[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『オートフィルタで表示させた分だけをカウントするマクロ』(容)
A列からG列までデータが入ったファイルがあります。
A〜D列までは一行目から万一万近いデータが全て連続データで埋まっており
E〜G列にはデータが入力されているセルと、ブランクのセルがあります。
EFGそれぞれデータが入力されているセルの数を数えるマクロを作りたいのですが、少してこずっています。
まず、数えるべき大元のデータ選別はA〜D列のデータで行います。
A列 B列 C列 D列 E列 F列 G列
レベル1 レベル2 レベル3
111 SSS 555 111 1 1 1 レベル3
111 SSS vvv 111 1 1 レベル2
111 SSS vvv 111 1 1 1 レベル3
111 SSS 222 111 1 レベル1
やりたいこととしては、D列を軸にA列に同じ並びのアルファベットがあった場合、
その件数を数えるというものです。
ただし、カウントするときはA列とC列をセットで考え、重複データはカウントしません。
つまり上の表でいう2行目・3行目の時はAとC列のデータが完全一致しているので
D列のデータに対し、件数としては一件とカウントする形です。
この表のデータ総件数は3件となります。
問題としているのは、この総件数をレベル別に分別する方法です。
ただし、レベルには強弱があり、G列>F列>E列の順です。
E〜G列全ての列に1が入っていた場合、そのデータはレベル3、FEのみに入っていた場合、そのデータはレベル2、E列のみに入っていた場合、そのデータはレベル1とカウントしたいのです。
総件数を割り出すマクロはできているのですが、レベル別のカウント方法が思いつきません。
方法としては、オートフィルタでG→F→Eの順に検索条件『1』で表示。それぞれFE列のデータをクリアしていく、という方法を取って見ましたが、そのままオートフィルタを解除せずに、レベルごとのカウントをしても、全体数のカウントをしてしまいます。
なにかよい解決方法があったら教えてください。お願いします。
With Range("A1").CurrentRegion
.AutoFilter Field:=7, Criteria1:="1" Columns(6).ClearContents Columns(5).ClearContents
End With
Dim cnt As Long, res(), tbl, dic Dim J As Long, JJ As Long, s1 As String, s2 As String
With Sheets("日本") tbl = .Range("A1").CurrentRegion.Value cnt = Evaluate("count(0/((match(" & .Name & "!d2:d" & UBound(tbl) & "," & _ .Name & "!d2:d" & UBound(tbl) & ",0))=row(1:" & UBound(tbl) - 1 & ")))") End With ReDim res(1 To cnt, 1 To 2) Set dic = CreateObject("scripting.dictionary") For J = 1 To UBound(tbl) s1 = tbl(J, 1): s2 = tbl(J, 1) & tbl(J, 3) If s1 = tbl(J, 4) Then If Not dic.exists(s2) Then If Not dic.exists(s1) Then JJ = JJ + 1: res(JJ, 1) = s1 dic(s1) = 1 Else dic(s1) = dic(s1) + 1 End If dic(s2) = True End If End If Next J For J = 1 To UBound(res) res(J, 2) = dic(res(J, 1)) Next J Sheets("結果").Range("A1").Resize(UBound(res), 2).Value = res
< 使用 Excel:Excel2003、使用 OS:WindowsXP >
結果はどこにどの様に表示されて ご呈示の例の場合はどの様な結果になれば良いのですか?
また、各データの右端に レベル1,2,3 と書かれていますが これは実際もあるデータでしょうか? それとも、わかりやすい様に書いてあるだけで E,F,G列から ルールに従って算出が必要でしょうか? (HANA) 2014/09/17(水) 16:09
お世話さまです。
説明が足りず大変失礼したしました。
>結果はどこにどの様に表示されて
>ご呈示の例の場合はどの様な結果になれば良いのですか?
まず、アウトプットは同ファイル内にある『結果』シートのA1セルからレベル順を横軸に、D列を縦軸にとって、下に向かって記述されます。
また、その際の形式としてはD列をキーにしてアルファベット順に並ぶ仕様です
結果シート
A列 レベル3 レベル2 レベル1
111 2 1 1
222 1 1
333 6 2 1
理想系としてはこんな形になります。
ちなみに、二行目の222以下は、今参考用に付け足したデータです。
最初に書いたマクロのコードだと、このレベル別仕分けの部分が出来ずに、
結果シート
A列
111 4
222 2
333 9
こんな形で合算で出てしまいます。
>また、各データの右端に レベル1,2,3 と書かれていますが
>これは実際もあるデータでしょうか?
>それとも、わかりやすい様に書いてあるだけで E,F,G列から
>ルールに従って算出が必要でしょうか?
はい。分かりやすくかいてあるだけで、実際にこのデータはありません。
EFG列からレベルを判別する必要があります。
(容) 2014/09/18(木) 09:50
こんな感じでどうですか?
'------ Sub YOU() Dim cnt As Long, res(), tbl, dic Dim J As Long, JJ As Long, s1 As String
With Sheets("日本") tbl = .Range("A1").CurrentRegion.Value End With
ReDim res(1 To UBound(tbl, 1), 1 To 4)
Set dic = CreateObject("scripting.dictionary") For J = 2 To UBound(tbl) If Not dic.Exists(tbl(J, 4)) Then cnt = cnt + 1 dic(tbl(J, 4)) = cnt res(cnt, 1) = tbl(J, 4) End If
s1 = tbl(J, 1) & "_" & tbl(J, 3) & "_" & tbl(J, 4) & "_" & tbl(J, 5) & "_" & tbl(J, 6) & "_" & tbl(J, 7) If Not dic.Exists(s1) Then dic(s1) = "" JJ = dic(tbl(J, 4)) If tbl(J, 7) = 1 Then 'G列に「1」がある場合(レベル3の場合) res(JJ, 2) = res(JJ, 2) + 1 'resの2列目に +1 ElseIf tbl(J, 6) = 1 Then 'F列に「1」がある場合(レベル2の場合) res(JJ, 3) = res(JJ, 3) + 1 'resの3列目に +1 ElseIf tbl(J, 5) = 1 Then 'E列に「1」がある場合(レベル1の場合) res(JJ, 4) = res(JJ, 4) + 1 'resの4列目に +1 End If End If Next
With Sheets("結果") .Range("A:D").ClearContents .Range("A1:D1").Value = Array("", "レベル3", "レベル2", "レベル1") .Range("A2").Resize(cnt, 4).Value = res End With End Sub '------ (HANA) 2014/09/18(木) 10:54
↑コード一部書き換えました。すみません。
>ちなみに、二行目の222以下は、今参考用に付け足したデータです。 の時に、合わせて その様になる元データも載せておいてもらえると良いと思います。 (HANA) 2014/09/18(木) 11:00
HANAさんへ 結果のヘッダだけ並びが逆な気がする(ぽそり (ご近所PG) 2014/09/18(木) 11:09
>結果のヘッダだけ並びが逆な気がする !Σ(・Д・;) そうですよね。。。( ̄▽ ̄;)
ご指摘ありがとうございます。 上記変更します。 (HANA) 2014/09/18(木) 11:18
ありがとうございます!
追記の件、申し訳ありません。確かに分かりにくいですよね。以後、気をつけます!
試しに走らせてみたところ、直していただいたものだと、ヘッダも綺麗に並びました^_^
ただ、カウントしている数が、何故か倍になっております。
それと、これは私の説明の仕方が分かりにくかったせいだと思いますが、
A列 B列 C列 D列 E列 F列 G列
レベル1 レベル2 レベル3 111 SSS 555 111 1 1 1 レベル3 111 SSS vvv 111 1 1 レベル2 111 SSS vvv 111 1 1 1 レベル3
↑上記の二行目、三行目のようにA・C列のデータが完全に一致する場合、そのデータは何行あったとしても、全て『一件のデータ』(つまり、一行分のデータとして扱う形になります。
分かりにくい記述で本当に申し訳ありません。。。
(容) 2014/09/18(木) 11:31
たびたびすみません。
全体的に数えなおしてみたところ、純粋に倍になっているわけではなく、
A列・D列の値が一致しないものも、カウントしているようでした。
(容) 2014/09/18(木) 11:48
>↑上記の二行目、三行目のようにA・C列のデータが完全に一致する場合〜〜 レベル2に1件と、レベル3に1件ですが レベルが高い方(レベル3)に1件 と数えれば良いですか?
もう一つお伺いしたいのですが、E:G列は 順番に「1」が入力されるのでしょうか? 場合によって、G列のみ「1」が入力される なんて事もあるのでしょうか?
>A列・D列の値が一致しないものも、カウントしているようでした。 あ、一致しないものはカウントしないんでしたね。 すみません。
そういったデータも含めて 検証に使える様な元データと希望結果を 載せてもらえると良いのですが。 (HANA) 2014/09/18(木) 11:54
一応こんな形で。。。
'------ Sub YOU2() Dim cnt As Long, MyC As Long, res(), tbl, dic Dim J As Long, JJ As Long, s2 As String
With Sheets("日本") tbl = .Range("A1").CurrentRegion.Value End With
ReDim res(1 To UBound(tbl, 1), 1 To 4) Set dic = CreateObject("scripting.dictionary") For J = 2 To UBound(tbl, 1) If tbl(J, 1) = tbl(J, 4) Then If Not dic.Exists(tbl(J, 4)) Then cnt = cnt + 1 dic(tbl(J, 4)) = cnt res(cnt, 1) = tbl(J, 4) End If End If Next
MyC = 1 For JJ = 7 To 5 Step -1 MyC = MyC + 1 For J = 2 To UBound(tbl, 1) If tbl(J, JJ) = 1 Then s2 = tbl(J, 1) & tbl(J, 3) If Not dic.Exists(s2) Then dic(s2) = "" res(dic(tbl(J, 1)), MyC) = res(dic(tbl(J, 1)), MyC) + 1 End If End If Next Next
With Sheets("結果") .Range("A:D").ClearContents .Range("A1:D1").Value = Array("", "レベル3", "レベル2", "レベル1") .Range("A2").Resize(cnt, 4).Value = res End With End Sub '------ (HANA) 2014/09/18(木) 12:09
度々、ありがとうございます。
毎度説明・情報が不足しておりまして、大変お手数をおかけいたします。本当に申し訳ございません。
>レベル2に1件と、レベル3に1件ですが
>レベルが高い方(レベル3)に1件 と数えれば良いですか?
→はい。レベルは常に高い方が優先となります。
>もう一つお伺いしたいのですが、E:G列は
>順番に「1」が入力されるのでしょうか?
> 場合によって、G列のみ「1」が入力される
>なんて事もあるのでしょうか?
→はい。可能性としてはございます。
遅くなりましたが、実際のデータはこんな形になっております。
レベルのヘッダーは元データにはついておりません。A〜C列には
ヘッダーがついておりますが、あまり意味はありません(集計上必要ない)
A列 B列 C列 D列 レベル1 レベル2 レベル3
HND CHI 29077 GNZ 1 1 1
GNZ DTT 29078 GNZ 1 1
GNZ CVG 29077 GNZ 1
GNZ MEM 29078 GNZ 1 1 1
GNZ CHI 29076 BRK 1
BRK MEM 29076 BRK 1
BCN CHI 731344 YOK 1 1
BRK CHI 738754 BRK 1 1
TYO NUE 731376 TYO 1 1
BRK CHI 738754 BRK 1 1
NLC CHI 838810 ITB 1 1
NLC YYZ 838816 ITB 1 1
KUL ATL 29077 GNZ 1 1
KUL CHI 29078 GNZ 1 1
KUL CHI 738402 NRT 1 1 1
guest CHI 738754 BRK 1 1
この表で言うと、二行目と四行目はAD列が同じでC列も同じなのでカウントとしては1行
レベル3にデータが入っておりますので、レベル3が1、という数え方になります。
アウトプット
レベル3 GNZ 1
また、5行目6行目のような形ですと、C・D列の値が一致しますが
A列はGNZ,BRKとなっているので、この場合は
アウトプット
レベル3 BRK 1
と、なり五行目はカウント対象にはなりません。
ちなみに、12:09分に更新していただいたコードですと、
res(dic(tbl(J, 1)), MyC) = res(dic(tbl(J, 1)), MyC) + 1 の部分で『実行エラー"9" インデックスが有効範囲にありません』というのが走ってしまいます。
(容) 2014/09/18(木) 13:27
>レベルのヘッダーは元データにはついておりません。A〜C列には >ヘッダーがついておりますが、あまり意味はありません(集計上必要ない) それで、データは何行目からですか?
>この表で言うと、〜〜〜 結果はどの様になれば良いですか?
>また、5行目6行目のような形ですと、C・D列の値が一致しますが 〜〜 は、ちょっとよくわからないです。
5行目は、A列とD列が違うので対象外。 6行目は、A列とD列が一致して 他にA列とC列が一致する組み合わせが無いので BRKのレベル2に+1 なら納得いくのですが。
ご呈示の例ですと(データが2行目から始まっているとして) レベル3 レベル2 レベル1 GNZ 1 1 BRK 1 1 TYO 1 の結果で良ければ↓のコードで出ますが。。。
'------ Sub YOU3() Dim cnt As Long, res(), tbl, dic Dim J As Long, JJ As Long, s2 As String
With Sheets("日本") tbl = .Range("A1").CurrentRegion.Value End With
ReDim res(1 To UBound(tbl, 1), 1 To 4) Set dic = CreateObject("scripting.dictionary") For J = 2 To UBound(tbl, 1) If tbl(J, 1) = tbl(J, 4) Then If Not dic.Exists(tbl(J, 4)) Then cnt = cnt + 1 dic(tbl(J, 4)) = cnt res(cnt, 1) = tbl(J, 4) End If End If Next
For JJ = 0 To 2 For J = 2 To UBound(tbl, 1) If tbl(J, 1) = tbl(J, 4) And tbl(J, 7 - JJ) = 1 Then s2 = tbl(J, 1) & tbl(J, 3) If Not dic.Exists(s2) Then dic(s2) = "" res(dic(tbl(J, 1)), JJ + 2) = res(dic(tbl(J, 1)), JJ + 2) + 1 End If End If Next Next
With Sheets("結果") .Range("A:D").ClearContents .Range("A1:D1").Value = Array("", "レベル3", "レベル2", "レベル1") .Range("A2").Resize(cnt, 4).Value = res End With End Sub '------
エラーが起きたり、希望する結果と違う場合は また教えて頂ければと思います。 (HANA) 2014/09/18(木) 15:01
ありがとうございます!
まさに、理想通りの動きです!
分かりにくい説明に加え、条件や資料などのご提示も至らない中
ここまで完璧なコードをご教示いただき、まことにありがとうございました!
大変助かりました!
次回、またこちらにご相談させていただく機会がございましたら、
ご指摘いただいた点にも注意致します。
本当にありがとうございました!
(容) 2014/09/18(木) 15:19
できましたか、良かったです。 要件をしっかり検証せず、テキトーなコードを載せてすみませんでした。
色々なパターンを網羅したサンプルデータと それを使った結果図も ご説明時に載せておいてもらうと 投稿者が勝手に同じ結果が出る様なコードを書いてくれるので 便利だと思います。
サンプルデータを作るのは、面倒なんですけどね。 実行してみてご自身で「どこが違うんだろう」なんて思わなくてよくなりますので。
最初にコードを投稿してもらっていたのは、助かりました。
ご近所PGさんも、ありがとうございました。<(_"_)> (HANA) 2014/09/18(木) 15:37
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.