Countifよりも早く重複数をカウントする方法ありますか？

1行目が項目、
2行目以降にデータが入っています。
合計30万行位あり、B列の重複数をカウントしたいのですが、とても時間がかかります。
数式は、
=countif(B:B,B2)
で、重複してる行全てに同じ数字を入れる必要があります。
（昇順にして上から1ずつ増やしていくカウント方式では駄目。)
同じデータが6個ある場合は、6行とも”６”が入っている必要あり。)

行った工夫としては
=countif($B1:$B300000,B2)

しかし、カウントする列が3列もあるので大変です。
もっと早く結果を出す方法は無いでしょうか？
VBAでも構わないのですが、、、

No.18 回答者： fujillin 回答日時： 2022/07/06 23:25

No17です。

＞大文字小文字が違っていても重複としてくれる方法は無いでしょうか？
＞事前にLower関数で小文字化すれば良いので面倒なら大丈夫です。
Lower関数と同様の処理を行えばよいでしょう。
VBAのLCase、UCase関数がこれに該当します。
https://docs.microsoft.com/ja-jp/office/vba/lang …

No13の処理では、一番最初に元データを配列vに読み込んでいますので、直後に全体を小文字化をしてから処理をするようにすれば、補足でご質問のような比較も可能です。
ただし、全角文字を半角にするような場合には工夫が必要になると思います。
（処理が複雑になれば、段々時間がかかることになります）

No.17 回答者： fujillin 回答日時： 2022/07/06 18:48

No16です。

＞1列だけ試してみたら1分かからず結果が返ってきました。
う～～ん。けっこう時間がかかりますね。
とは言っても、更に速くなりそうな方法はVBAの範囲では残念ながら思いつきません。

＞せっかくなら自動で3回処理できないかなと。
列が不明なので、別に設定する方式にしておいただけですので、決まっているのならそれに対応させてしまえばよいでしょう。
（37列、38列）と（40列、41列）、（43列、44列）と規則性があるようなので、列の値を変数にして全体をループすればすむと思われます。

あるいは、現状のものをサブルーチン化しておいて、
　Call Subroutine( 元の列, 記入列 )
のようにして呼び出すメインルーチンを付け加えても宜しいかと思います。
（3回だけなら、ループなど利用せずに直接3行書いても変わらないですね）

この回答へのお礼

ありがとうございます。サブルーチン化するのが初めてなのでやってみます。

No.13での事、ここで書かせてください。
高速になってとても助かるのですが一点見つけました。
大文字小文字まで区別してしまうため、以下のような場合重複としてカウントしてくれませんでした。
Excelの関数だと両方とも「2」いう結果が返ってきました。

Beijing12349876　　→1
BEIJING12349876　→1

大文字小文字が違っていても重複としてくれる方法は無いでしょうか？
事前にLower関数で小文字化すれば良いので面倒なら大丈夫です。

お礼日時：2022/07/06 21:09

No.16 回答者： fujillin 回答日時： 2022/07/05 14:37

No13です。

再度見たら、無駄が・・・

No13の
＞If t = "" Then v(i, 1) = "" Else v(i, 1) = d(t)
は無駄でした。

　If t <> "" Then v(i, 1) = d(t)
ですみますね。

※ 速度的にはあまり変わらないと思いますが、一応、訂正しておきます。

この回答へのお礼

ありがとうございます。
差し替えて実行しました！違いは分かりませんが問題ないようです。

お礼日時：2022/07/06 10:58

No.15 回答者： mike_g 回答日時： 2022/07/05 13:17

[No.10お礼]へのコメント、

サヨナラはしたけれど、…(*^_^*)
》 正直言うと、貴方の添付してくれた画像が小さくて…
早く言ってよオ～ｯ！
それは仰るとおり、元は大きな画像であっても「本サービスの仕様」で縮小されチャウんですよね。でも、Win10Pro Ver.21H2を使用中の私は、該当図をマウスで右クリック⇒[新しいタブで画像を開く]⇒作成された該当タブ[M.jpg(500x271)]をマウスでツンツンした画像は馬鹿デカイので、Ctrlキーを抑えて[－](ﾏｲﾅｽ)キーをツンツンして、縮小せずには居られない⇒鮮明になる
という次第。
知らなかったでしょ？是非、オタメシあれ。(^_^)

この回答へのお礼

ご親切にコメントありがとうございます。
仰る通りに本スレッドの添付画像を右クリックして新しいタブで開いてみましたが、小さい画像のまま別タブ表示されました^^;
それをCtrl＋プラスキーで拡大すると、粗くはなりますが判別できるサイズにはなりました。ChromeでもEdgeでも同様でした。
新しいタブで画像を開と、投稿する時の画像サイズ等倍で表示できる機能なのでしょうかね。だとすると投稿時のサイズ次第かと。
あと一定サイズ以上は自動的に縮小されるみたいなのでその辺の影響かもしれませんね。

お礼日時：2022/07/08 17:55

No.14 回答者： ひでオンジ 回答日時： 2022/07/05 02:57

fujillinさんこんばんは

VBAからセルにアクセスすると遅いけど、ディクショナリーを使って集計、配列編集して一気に貼り付ければパフォーマンスを最大限に活かせる
流石ですm(_ _)m

No.13 回答者： fujillin 回答日時： 2022/07/04 22:47

こんばんは

＞VBAでも構わないのですが、、、
VBAは必ずしも速くはありませんので、単体の計算だけで比べればエクセル本体の方が速いはずです。
（関数1箇所だけなら、範囲が広くても瞬時に結果がでます。）
ただし、同じ関数を大量のセルに設定すると同様の計算を何度も行うことになるので、時間がかかる可能性はありますね。

以下は、VBAで全体をまとめて同時に計算してしまう例です。
VBAの場合、セルにアクセスすると時間がかかるため、速度を優先するのにメモリの使用量が多い方法になっています。
マシンの性能や使用可能メモリの影響を受けますが、私の環境では、出力までを含めて300000行を処理するのに約1秒でした。

※ どこかの列に結果を出力するものと思いますが、なんの記載も無いので、ひとまずD列に出力するようにしてあります。
※ 何回投稿しても「投稿中エラー」が発生してしまうため、通常とは少し異なる記述法に変えてあります。

Sub Q13027572()
Dim d, v, t, n As Long, i As Long
Const c1 = "B" '← カウント対象データ列
Const c2 = "D" '← 出力列
Const dic = "Scripting.Dictionary"

n = Cells(Rows.Count, c1).End(xlUp).Row - 1
If n < 1 Then Exit Sub
Set d = CreateObject(dic)
v = Range(c1 & "2").Resize(n).Value

For i = LBound(v) To UBound(v)
t = v(i, 1)
If t <> "" Then
If d.Exists(t) Then d(t) = d(t) + 1 Else d.add t, 1
End If
Next i
For i = LBound(v) To UBound(v)
t = v(i, 1)
If t = "" Then v(i, 1) = "" Else v(i, 1) = d(t)
Next i

d.RemoveAll
Range(c2 & "2").Resize(n).Value = v
MsgBox "END"
End Sub

この回答へのお礼

ありがとうございます。すごいです！
1列だけ試してみたら1分かからず結果が返ってきました。
正直、その列だけピボットテーブルで集計できるからOKと思ってましたが、
やっぱりマクロで自動化出来るならそれに越したことはありません。
ここまで具現化してしまったのでちょっと希望と欲が出てきました。

当方が実際に使っている集計表で列を確認したところ
カウント対象データ列と出力列の組み合わせが、以下の3パターンあります。
AK、AL
AN、AO
AQ、AR

ソースのConst c1、c2の箇所でを書き換えて3回回せば良いので問題ないのですが、
せっかくなら自動で3回処理できないかなと。
簡単に出来るのであればご教授ください。

お礼日時：2022/07/06 11:03

No.12 回答者： tatsumaru77 回答日時： 2022/07/04 22:37

Scripting.Dictionaryをつかうと、１列につき、約３０万件で２５秒程度ですね。

（当方のマシンの実測値です）

No.11 回答者： Qchan1962 回答日時： 2022/07/04 19:24

こんばんは、

＞VBAでも構わないのですが、、、
VBAの場合、ユニーク数が多い様であれば、それなりに処理時間がかかりそうかな・・CountIf　遅いので
ユニーク数が少なければ、・・・（どの位を想定？）
CountIfの回数を減らして、テスト的にB列の結果をC列に出力とかで

数百とかユニーク数があるなら・・時間のある時に

Sub test()
Dim i As Long, j As Long
Dim Rng As Range
Dim myList, aryData
Dim tmp(), ans()

With ThisWorkbook.Worksheets(1)
Set Rng = .Range(.Cells(1, "B"), .Cells(.Rows.Count, "B").End(xlUp))
myList = WorksheetFunction.Unique(Rng)

ReDim tmp(UBound(myList), 1)
ReDim ans(Rng.Rows.Count)

For i = 1 To UBound(myList)
tmp(i, 0) = myList(i, 1)
tmp(i, 1) = Application.CountIf(Rng, myList(i, 1))
Next

aryData = Rng.Value

For i = 1 To UBound(aryData)
For j = 1 To UBound(tmp)
If tmp(j, 0) = aryData(i, 1) Then ans(i - 1) = tmp(j, 1): Exit For
Next
Next
'キヤスメ
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

.Cells(1, "C").Resize(UBound(ans)).Value = WorksheetFunction.Transpose(ans)

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End With

End Sub

＞ピボット集計　賛成です
＞Vlookupで　　どうかな？

No.10 回答者： mike_g 回答日時： 2022/07/04 19:02

[No.5お礼]へのコメント、

私の添付図が「イマイチ理解できず」は(理解力の問題なので)仕方ないとしても、
貴方から「しかし、左端図の結果を得たい」なんてな頓珍漢なコメントを頂戴するようでは、ここでオサラバ、退散させていただきます。
ちなみに、私の左端図は結果でなくて、開始図ですよｯ！
「左端図を最終的に右端図にする」って申し上げていたじゃな～いｯ！
サ・ヨ・ナ・ラ(^_^)/~~~

この回答へのお礼

正直言うと、貴方の添付してくれた画像が小さくて(これは本サービスの添付画像の仕様ですかね)、
更にはその時私が使用していたノートの液晶画面が小さくて、文字が潰れて読めた物じゃなかったんです。
作業に焦っていた当時、拡大して解読してる余裕はなかったので、自分の理解不足とお礼で書きました。
頓珍漢と思わせて失礼しました。
ありがとうございました。

お礼日時：2022/07/04 22:45

No.9 回答者： mike_g 回答日時： 2022/07/04 17:13

[No.5お礼]へのコメント、

》 流れがイマイチ理解できず…
オヤオヤ、困ったモンですね。
私の方ではイマイチどころか、貴方が記述された箇処にサッパリポンなところがあります。

》 重複してる行全てに同じ数字を入れる
と確かに仰いましたよね？
=countif(B:B,B2)の戻り値が 1 以外は、日本語的に、全～部重複してる数を表してますよね？
C列が「 1 以外」の 2 以上の B列の同じ行全てに同じ数字 6 を入れるンじゃなかったの、日本語的に？！

この回答へのお礼

No.4のお礼に書きましたが、
言葉で説明するより具体例を挙げた方が早いですね。
失礼しました。

やりたかったのはこういう事です。
ピボット集計した結果をVlookupで当てはめるのが一番効率良いと考えています。もっと良い方法あれば助かります。
----------
B列、C列
鈴木、6
佐藤、2
阿部、3
田中、2
鈴木、6
鈴木、6
井出、1
阿部、3
木下、1
鈴木、6
佐藤、2
田中、2
鈴木、6
阿部、3
鈴木、6

お礼日時：2022/07/04 17:36