[[20140917131315]] 『オートフィルタで表示させた分だけをカウントする』(容) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『オートフィルタで表示させた分だけをカウントするマクロ』(容)

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

HANA様

お世話さまです。

説明が足りず大変失礼したしました。

>結果はどこにどの様に表示されて
>ご呈示の例の場合はどの様な結果になれば良いのですか?

まず、アウトプットは同ファイル内にある『結果』シートの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

HANA様

ありがとうございます!
追記の件、申し訳ありません。確かに分かりにくいですよね。以後、気をつけます!

試しに走らせてみたところ、直していただいたものだと、ヘッダも綺麗に並びました^_^

ただ、カウントしている数が、何故か倍になっております。

それと、これは私の説明の仕方が分かりにくかったせいだと思いますが、

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


HANA様

たびたびすみません。
全体的に数えなおしてみたところ、純粋に倍になっているわけではなく、
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

HANA様

度々、ありがとうございます。
毎度説明・情報が不足しておりまして、大変お手数をおかけいたします。本当に申し訳ございません。

>レベル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

HANA様

ありがとうございます!

まさに、理想通りの動きです!

分かりにくい説明に加え、条件や資料などのご提示も至らない中
ここまで完璧なコードをご教示いただき、まことにありがとうございました!

大変助かりました!

次回、またこちらにご相談させていただく機会がございましたら、
ご指摘いただいた点にも注意致します。
本当にありがとうございました!

(容) 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.