処理速度 万行

質問

失礼します現在重複があればX行の隣に印を付けるというコードを書いているのですがデータ量が8万列あり、自身で下記のコードを実行すると応答なしとなってしまいます。
どう記述すれば機能するのでしょうか？よろしくお願いします。

Sub Sample2()
Dim c As Range
With Range("X1", Range("X" & Rows.count).End(xlUp))
.Offset(, 1).ClearContents
For Each c In .Cells
If WorksheetFunction.CountIf(.Cells, c) > 1 Then c.Offset(, 1) = "●"
Next
End With
End Sub

回答No.2

ushi2015 · ベストアンサー

こんにちは
CountIfも遅いですし、一個一個セルにアクセスするのも遅い原因かと思います。
Sub test()
　　Dim i As Long
　　Dim v As Variant
　　Dim d As Object

　　Set d = CreateObject("Scripting.Dictionary")

　　With Range("X1", Range("X" & Rows.Count).End(xlUp))
　　　　.Offset(, 1).ClearContents
　　　　v = .Resize(, 2)
　　　　For i = 1 To UBound(v, 1)
　　　　　　If d.Exists(v(i, 1)) Then
　　　　　　　　d(v(i, 1)) = d(v(i, 1)) + 1
　　　　　　Else
　　　　　　　　d.Add v(i, 1), 1
　　　　　　End If
　　　　Next
　　　　For i = 1 To UBound(v, 1)
　　　　　　v(i, 2) = IIf(d(v(i, 1)) > 1, "●", "")
　　　　Next
　　　　.Resize(, 2) = v
　　End With
End Sub

回答No.3

imogasi

先日、OKWAVEの質問に、重複をマークする、という質問があり、私は
http://okwave.jp/qa/q9197965.html?f=mail_thanks
のNo2で「ソート法」というのを紹介しました。
本件でその方法をテストデータで具体的にやってみた。
＝＝＝
Sub test01() '乱数で８万元数値データ作成　A列
For i = 1 To 80000
Cells(i, "A") = Int(Rnd() * 1000000#)
Next i
End Sub
'-----
Sub test02() '元データに連番を振る　B列
For i = 1 To 80000
Cells(i, "B") = i
Next
End Sub
'---
Sub test03()
'－－－A列でソート
Worksheets("Sheet1").Range("A1:B80000").Sort Key1:=Range("A1"), Order1:=xlAscending
'－－同じ値の行のC列にマークを付ける
For i = 2 To 80000
If Cells(i - 1, "A") = Cells(i, "A") Then
Cells(i, "C") = "○"
End If
Next i
'－－当初データの順に復元
Worksheets("Sheet1").Range("A1:C80000").Sort Key1:=Range("B1"), Order1:=xlAscending
End Sub
＝＝＝＝
時間は、Test01、Test02、Test03それぞれ１－２秒で終わった。
Test02はTest0１のコードの終りに含めることができる。
ーーー
＞下記のコードを実行すると応答なしとなってしまいます
が今のパソコンで、手に負えない量のものかどうか、調べたかったのでやってみた。
以上の実験から、データ数が８万で、多すぎてじかんがかかるということはないと思う。
何か処理ロジックかコードにエラーがあると思う。
＝＝
ソート法
昔（パソコン普及の時代の前）から、ソート法は、オフラインバッチ処理で、処理ロジックで重用されたもので、メーカーが作る、ユティリティソフトのソートのロジック（やその処理スピード）などもソフトメーカーが力を注ぎ、MSでも完成されたものになっていると思う。

回答No.1

SI299792

countif は遅いです。一つ一つ比較していますから。
=80000*80000で6400000000回比較をすることになります。
セルに直接数式を書き込んでも同じでした。

データを並べ替え、上下だけ比較して、元に戻す。私のパソコンで試したら、７秒でできました。

Sub Macro2()
'
Dim iy As Long
Dim iye As Long
'
Aplication.ScreenUpdating = False
'
iye = Range("X" & Rows.Count).End(xlUp)
[Y:Y].ClearContents
'
For iy = 1 To iye
Cells(iy, "W") = iy
Next iy
'
[W:Y].Sort Key1:=[X1]
'
For iy = 2 To iye
If Cells(iy - 1, "X") = Cells(iy, "X") Then
Cells(iy - 1, "Y") = "●"
Cells(iy, "Y") = "●"
End If
Next iy
'
[W:Y].Sort Key1:=[W1]
[W:W].ClearContents
'
End Sub
'

ただし、Ｗをワークエリアに使っているのでＷは消えます。
もしＷが使えないなら、別シートにコピーしてから、処理をするしかないですね。