列のユニークな文字列の個数を数える(条件付き)

質問

こんにちは。

「Excel 列の中のユニークな文字列の個数を数える」
http://okwave.jp/qa/q7469801.htmlではお世話になりました。

Excel 2007でA列にあるユニークな文字列の個数を数える
マクロを教えていただき助かりました。

次のステップですが、
A列 　　 H列
ABC12345 AB
ABC12345 AB
ABC12345 AB
ABC12345 AB
のようにH列がABだけのものの個数を数えたいです

ABC54321 AB
ABC54321 CD
ABC54321 AB
ABC54321 AB
の様なものは数えません

どのような条件をつければユニークな個数が数えられますか？
おわかりの方お教えください。

回答No.8

emaxemax · ベストアンサー

ANo1、4、7のemaxemaxです。

> mt2008さんよりも多少速いかも。

速度がお望みですか。
ではこうやったらどうでしょう？（二重ループを回避しました。）
20,000件のデータで試しましたが1秒かかりませんでした。

Sub test004()
Dim st As Single
st = Timer
Dim myV
Dim i As Long, j As Long
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")
myV = Range("A1", Cells(Rows.Count, "H").End(xlUp)).Value
j = UBound(myV, 1)
For i = 1 To j
If Not myDic.exists(myV(i, 1)) Then
If myV(i, 8) = "AB" Then
myDic.Add myV(i, 1), Empty
End If
Else
If myV(i, 8) <> "AB" Then
myDic.Remove (myV(i, 1))
End If
End If
Next
MsgBox myDic.Count & "個", , Timer - st & "秒要しました。"
End Sub

お礼

ありがとうございます。

emaxemaxさんのマクロでやってみます。

長期になりましたので一旦回答を閉めます。
回答していただいた皆さんありがとうございました。

回答No.10

emaxemax

emaxemaxです。
何度もすみません。
これではどうでしょう？

Sub test007()
Dim st As Single
st = Timer
Dim myV, myW
Dim i As Long, j As Long, n As Long
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")
myV = Range("A1", Cells(Rows.Count, "H").End(xlUp)).Value
j = UBound(myV, 1)
For i = 1 To j
If Not myDic.exists(myV(i, 1)) Then
If myV(i, 8) <> "AB" Then
myDic.Add myV(i, 1), 1
Else
myDic.Add myV(i, 1), 0
End If
Else
If myV(i, 8) <> "AB" Then
myDic(myV(i, 1)) = myDic(myV(i, 1)) + 1
End If
End If
Next
j = myDic.Count
For i = 1 To j
If myDic.items()(i - 1) > 0 Then
n = n + 1
End If
Next
MsgBox j - n & "個", , Timer - st & "秒要しました。"
End Sub

回答No.9

emaxemax

ANo1、4、7、8のemaxemaxです。

ANo8の回答は誤りでした。
無視してください。

回答No.7

emaxemax

ANo1、4のemaxemaxです。
おっしゃる意味をやっとつかめました。
H列にAB以外の表示があるものは、H列がABであるデータも無視するのですね？
それならこれでいかがでしょう？

Sub test003()
Dim myV
Dim i As Long, n As Long, j As Long
Dim flg As Boolean
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")
myV = Range("A1", Cells(Rows.Count, "H").End(xlUp)).Value
j = UBound(myV, 1)
For i = 1 To j
If myV(i, 8) = "AB" Then
flg = True
For n = 1 To j
If myV(n, 1) = myV(i, 1) And myV(n, 8) <> "AB" Then
flg = False
Exit For
End If
Next n
If flg Then
myDic(myV(i, 1)) = Empty
End If
End If
Next i
MsgBox myDic.Count & "個"
End Sub

お礼

ありがとうございます。
この方法で正しく出力できました。

mt2008さんよりも多少速いかも。

回答No.6

tom04

No.5です！
たびたびごめんなさい。
書き忘れたコトがありますので・・・

前回のコードはSheet1の1行目はタイトル行で、データは2行目以降にあるとした場合のコードです。
もしデータが1行目からあるのであれば

＞MsgBox "データ数は、" & i - 1 & "個です。"
を
＞MsgBox "データ数は、" & i & "個です。"
に変更してください。

何度も失礼しました。m(_ _)m

お礼

わざわざありがとうございます。
>前回のコードはSheet1の1行目はタイトル行で、データは2行目以降にあるとした場合のコードです。
それで結構です。

回答No.5

tom04

こんばんは！
前回投稿した者です。

前回のコードではかなりの時間を要したと思いますので、
今回はオートフィルタとフィルタオプションの設定でやってみました。

Sheet2を作業用のSheetとして使っていますので、Sheet2はまっさらな状態だとします。
前回同様、Sheet1のVBE画面にコピー＆ペーストしてマクロを実行してみてください。

Sub test()
Dim i As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet2")
On Error Resume Next
Application.ScreenUpdating = False
Columns(1).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Range(Columns(1), Columns(8)).Copy Destination:=ws.Cells(1, 1)
ws.Columns("A:H").AutoFilter
ws.Range(Cells(2, 1), Cells(i, 8)).AutoFilter field:=8, Criteria1:="AB"
i = ws.Cells(Rows.Count, 1).End(xlUp).Row
ws.Cells.Clear
Worksheets("Sheet1").Select
Selection.AutoFilter
Application.ScreenUpdating = True
MsgBox "データ数は、" & i - 1 & "個です。"
End Sub

参考になりますかね？m(_ _)m

回答No.4

emaxemax

ANo1のemaxemaxです。
補足を見ましたが、「この様なH列にAB以外の文字があるものは数えません」とある例にABがあるのが解せませんが、まあいいです。
そんなことよりも私の書いたコードを試した結果はどうだったのでしょうか？

なお、ANo2さんご回答のコードとの違いは、私のはそれぞれの出現数もカウントしていることです。

最後の部位に

Set ws = Worksheets.Add
ws.Range("A1").Resize(myDic.Count).Value = Application.Transpose(myDic.keys)
ws.Range("B1").Resize(myDic.Count).Value = Application.Transpose(myDic.items)

を書きくわえれば、新たなシートが挿入され、それぞれの出現数を表示すると思います。

補足

回答有難うございます。

H列にABが入っている行の総数を数えているようです。

実際に300行ほどのファイルで確かめましたが貴マクロでは
123個。ひとつひとつ数えた結果は17個でした。

H行がABだけのA行の同一文字列をまとめて1個と数えたいのです。

回答No.3

mt2008

A列にあるデータのうち、同じ値を持つ行のH列の値が必ず「AB」であるデータが何種類あるかをカウントするって事でしょうか？
で、あれば↓で行けると思いますが、データ数が多くなると重くなりそう……。

Sub Sample()
　　nTotal = 0
　　For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
　　　　If Range("H" & i) = "AB" Then
　　　　　　rtn = Application.WorksheetFunction.CountIfs(Range("H:H"), "<>AB", Range("A:A"), Cells(i, 1))
　　　　　　If rtn = 0 Then
　　　　　　　　nTotal = nTotal + 1 / Application.WorksheetFunction.CountIf(Range("A:A"), Cells(i, 1))
　　　　　　End If
　　　　End If
　　Next i
　　MsgBox nTotal & "個"
End Sub

お礼

回答有り難うございます。
400行ほどのファイルで試したところ、貴マクロと
一つづつ数えた結果が一致しました。

本来は23000行ほどですのでどのくらい時間がかかるかわかりませんが
計算ができそうです。

補足

ありがとうございます。
まずはmt2008さんのマクロを使わせていただきます。

回答してくださった皆さんありがとうございます。
一度質問を閉めます。

回答No.2

watabe007

参考に
Sub Test2()
　　Dim i As Long, v As Variant, Start As Single

　　Start = Timer
　　v = Range("A1", Cells(Rows.Count, "H").End(xlUp)).Value
　　With CreateObject("Scripting.Dictionary")
　　　　For i = 1 To UBound(v)
　　　　　　If v(i, 8) = "AB" Then .Item(v(i, 1)) = Empty
　　　　Next
　　　　MsgBox .Count & "件", 64, "処理時間：" & Application.Round(Timer - Start, 2) & "秒"
　　End With
End Sub

回答No.1

emaxemax

ABC54321 AB
ABC54321 CD
ABC54321 AB
ABC54321 AB
の様なものは数えません

ここがわかりません。
2番目以外はH列がABですよね？

H列がABという条件でA列のユニークな個数を求めるのですよね？

それならこれではどうでしょう？

Sub test01()
Dim myV
Dim i As Long
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")
myV = Range("A1", Cells(Rows.Count, "H").End(xlUp)).Value
For i = LBound(myV, 1) To UBound(myV, 1)
If myV(i, UBound(myV, 2)) = "AB" Then
If Not myDic.exists(myV(i, 1)) Then
myDic.Add myV(i, 1), 1
Else
myDic(myV(i, 1)) = myDic(myV(i, 1)) + 1
End If
End If
Next
MsgBox myDic.Count
End Sub

補足

回答ありがとうございます

>ここがわかりません。
>2番目以外はH列がABですよね？
この様なH列にAB以外の文字があるものは数えません

>H列がABという条件でA列のユニークな個数を求めるのですよね？
その通りです。
H列がABだけであるもので、A列のユニークな個数を求めたいのです。