[[20190716213412]]　『ある条件に合う値（あるいは値のあるセル）を数え』（駅前）　ページの最後に飛ぶ

『ある条件に合う値（あるいは値のあるセル）を数え、全シートに適用する』（駅前）

具体的な質問です。

以下の例のようにBの列にURLがたくさん記載されています。URLの直前にType からTypeDまでの4種のタイプが記載されており、URLはこれで分類されています。このType AとType B、Type C、Type Dに含まれるURLの数を自動的に計算し、C1、C2、C3、C4に数を挿入したいのです。そして、これを100件ある全シートで同じ処理を行いたいのです。いい方法がありますでしょうか？

ちょっと難しいのは、TypeABCDの出現の有無はランダムです（ただしABCDの順序は不動です）。つまり、シート2のようにTypeAがない場合やURLが一つもない（空白）シートというのもありえます。その場合もC1、C2、C3、C4に0を挿入したいのです。ちなみに、あまり重要ではないでしょうが、URLは重複する可能性もあります。URLはhttpとhttpsしかないと思います。マクロでもかまいませんので、お願いします。

シート１

 　　A　　　　B　　
1　　　　Type A
2　　　　http://example.com
3　　　　https://sample.com
4　　　　Type B 
5　　　　https://abc.com
6　　　　http://efg.com
7　　　　https://hij.com
8　　　　Type C
9　　　　https://hij.com
10　　　 Type D
11　　　 https://klm.com

この場合、C1に2、C2に3、C3に1、C4に1を挿入します

シート２

 　　A　　　　B　　
1　　　　Type B 
2　　　　https://abc.com
3　　　　http://efg.com
4　　　　https://hij.com
5　　　　Type C
6　　　　https://hij.com

この場合、C1に0、C2に3、C3に1、C4に0を挿入します

シート３

この場合、C1に0、C2に0、C3に0、C4に0を挿入します

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

すみません、シート2はTypeAがないと書きましたが、正確にはTypeAとTypeDの二つがないケースでした。
（駅前） 2019/07/16(火) 22:16

 >URLは重複する可能性もあります。
 これは重複するURLは一つとするのだろうか？
（ねむねむ） 2019/07/17(水) 09:03

 ああ、例から見るとタイプが違っておなじURLがあるということか？
 それとも同じタイプ内で重複があるのだろうか？
 で、もし同じタイプ内の重複がある場合、どう数えるのだろうか？
（ねむねむ） 2019/07/17(水) 09:08

 もう一つ質問。
 Type内のURLの個数は最大何個だろうか？
（ねむねむ） 2019/07/17(水) 09:21

Sub main()

    Dim dt(3) As Long, c As Range, r As Range
    For Each c In Range("B:B").SpecialCells(2)
        If Left(c.Value, 4) = "http" Then
            Set r = Range(Range("B1"), c).Find("Type", , , xlPart, , xlPrevious)
            If Not r Is Nothing Then
                Select Case r.Value
                    Case "Type A": dt(0) = dt(0) + 1
                    Case "Type B": dt(1) = dt(1) + 1
                    Case "Type C": dt(2) = dt(2) + 1
                    Case "Type D": dt(3) = dt(3) + 1
                End Select
            End If
        End If
    Next c
    Range("C1:C4").Value = WorksheetFunction.Transpose(dt)
End Sub
（mm） 2019/07/17(水) 09:53

 >このType AとType B、Type C、Type Dに含まれるURLの数を自動的に計算し、C1、C2、C3、C4に数を挿入したい 
 >のです。そして、これを100件ある全シートで同じ処理を行いたいのです。いい方法がありますでしょうか？

 Sub test()
     Dim a, ws As Worksheet, x, i As Long, n, s As String
     For Each ws In Worksheets
         x = Filter(ws.[transpose(if(left(b1:b10000,4)="Type",row(1:10000)))], False, 0)
         ReDim a(1 To 4, 1 To 1) As Long
         If UBound(x) > -1 Then
             ReDim Preserve x(UBound(x) + 1)
             x(UBound(x)) = ws.Range("b" & Rows.Count).End(xlUp)(2).Row
             For i = 0 To UBound(x) - 1
                 s = Right$(Trim$(ws.Cells(x(i), 2)), 1)
                 n = Switch(s = "A", 1, s = "B", 2, s = "C", 3, s = "D", 4)
                 If Not IsNull(n) Then a(n, 1) = x(i + 1) - x(i) - 1
             Next
         End If
         ws.[c1:c4] = a
     Next
 End Sub

（seiya） 2019/07/17(水) 10:34

 とりあえず同一Type内に重複URLがないとする。
 まず、シートタブを右クリックしてすべてのシートを選択。
 その状態でC1セルに
 =SUMPRODUCT((COUNTIF(INDIRECT("B1:B"&ROW($1:$100)),"Type*")*(LEFT(B$1:B$100,4)="http")=ROW(A1))*1)
 と入力してC4セルまでフィルコピー。
 これですべてのシートのC1セルからC4セルに式が入力される。
（ねむねむ） 2019/07/17(水) 10:37

 なお上記式はB列のデータが最大100行までに対応している。
 もっと行があるときは式中の$100を大きくしてくれ。
（ねむねむ） 2019/07/17(水) 10:38

 すまない。
 これだとTypeAがない場合C1セルにTypeBの個数を出してしまう。
 上記の私の回答は無視してくれ。

（ねむねむ） 2019/07/17(水) 10:40

 D列を作業列として使う。
 全シートを選択した状態でD1セルに
 =IF(B1="","",IF(LEFT(B1,4)="Type",RIGHT(B1,1),OFFSET(D1,-1,)))
 と入力して下へフィルコピー。
 C1セルに
 =MAX(0,COUNTIF(D:D,CHAR(64+ROW(A1)))-1)
 と入力してC4セルまでフィルコピーで。
（ねむねむ） 2019/07/17(水) 10:48

採用した解答です。

いろいろ方法はあるかと思いますが、シンプルさとわかりやすさで、今回はmmさんのコードを採用させていただきました。本当にありがとうございます。ほかの皆さんのコードも参考にさせていただきました。それぞれ勉強になりました。ありがとうございます。

Sub main()

    Dim dt(3) As Long, c As Range, r As Range
    For Each c In Range("B:B").SpecialCells(2)
        If Left(c.Value, 4) = "http" Then
            Set r = Range(Range("B1"), c).Find("Type", , , xlPart, , xlPrevious)
            If Not r Is Nothing Then
                Select Case r.Value
                    Case "Type A": dt(0) = dt(0) + 1
                    Case "Type B": dt(1) = dt(1) + 1
                    Case "Type C": dt(2) = dt(2) + 1
                    Case "Type D": dt(3) = dt(3) + 1
                End Select
            End If
        End If
    Next c
    Range("C1:C4").Value = WorksheetFunction.Transpose(dt)
End Sub

ちなみに、これは１シートのみで有効な手段なので、全シートに適用するために、以下の単純なコードを追加しました。

Sub urlall()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
main
Next
End Sub

（駅前） 2019/07/17(水) 21:45

コメント返信：

[ 一覧(最新更新順) ]

[[20190716213412]] 『ある条件に合う値（あるいは値のあるセル）を数え』（駅前） ページの最後に飛ぶ

[[20190716213412]]　『ある条件に合う値（あるいは値のあるセル）を数え』（駅前）　ページの最後に飛ぶ