| |
hisaoさん、つんさん、Asakiさん、おはようございます。
自由研究してみました。
こういう検索は、私は、「Asakiさんのようなコードが処理速度はより速い」と
思っていて同様なご質問の回答にはAsakiさんが投稿されたようなコードを記述した
覚えがあります（コードは、処理速度だけが指標とはいえませんが・・・）。
いくつかサンプルコードを作って（つんさんとAsakiさんのコードも貸して頂いて）みました。
尚、結果は後述しますが、これはコードの優劣でなく、純粋にVBAの実験だとご了承ください。
以下のコードで実験しました(実は、昨日から走らせて中々終わらないんで途中で終わらせたんですが、4時間かかりました）。
コードは、6つのサンプルコードの処理時間を新規ブックに記録したものです。
'===================================================================
Sub main()
Dim d_sht As Worksheet
Set d_sht = Workbooks.Add.Worksheets(1)
d_sht.Range("a1:h1").Value = Array("データ数", "test1", _
"test2", "test3", "test4", "test5", "test6", "欠番数")
With ThisWorkbook
.Activate
With Worksheets(1)
.Activate
idx = 2
For cnt = 100 To 3000 Step 1000 '←ここの値を変更すると
' 短時間のテストも可能です
.Cells.ClearContents
With .Range(.Cells(1, 1), .Cells(cnt, 1))
.Formula = "=int(rand()*" & cnt & ")+1"
.Value = .Value
End With
Call test1(ot, cnt)
d_sht.Cells(idx, 1).Value = cnt
d_sht.Cells(idx, 2).Value = Format(ot, "hh:mm:ss")
Call test2(ot, cnt)
d_sht.Cells(idx, 3).Value = Format(ot, "hh:mm:ss")
Call test3(ot, cnt)
d_sht.Cells(idx, 4).Value = Format(ot, "hh:mm:ss")
Call test4(ot, cnt)
d_sht.Cells(idx, 5).Value = Format(ot, "hh:mm:ss")
Call test5(ot, cnt)
d_sht.Cells(idx, 6).Value = Format(ot, "hh:mm:ss")
Call test6(ot, cnt)
d_sht.Cells(idx, 7).Value = Format(ot, "hh:mm:ss")
d_sht.Cells(idx, 8).Value = WorksheetFunction.Count(Range("b:b"))
idx = idx + 1
DoEvents
Next cnt
End With
End With
End Sub
'========================================================================
Sub test1(out_time, cnt)
'Asakiさんのコードを参考
st = Now()
Dim ans As Range
Dim rng As Range
Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
ad = rng.Address
With Range("c1:c" & cnt)
.Formula = "=CountIf(" & ad & ",Row())"
For Each cc In .Cells
If cc.Value = 0 Then
Cells(idx + 1, 2).Value = cc.Row
idx = idx + 1
End If
Next
.ClearContents
End With
Set rng = Nothing
out_time = Now() - st
End Sub
'=========================================================
Sub test2(out_time, cnt)
'Asakiさんのコードをちょっと変更
st = Now()
Dim ans As Range
Dim rng As Range
Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
ad = rng.Address
With Range("d1:d" & cnt)
.Formula = "=if(CountIf(" & ad & ",Row())=0,row(),"""")"
.Value = .Value
On Error Resume Next
Set ans = .SpecialCells(xlCellTypeConstants)
If Err.Number = 0 Then
For Each cc In ans
Cells(idx + 1, 3).Value = cc.Value
idx = idx + 1
Next
End If
.ClearContents
End With
Set rng = Nothing
out_time = Now() - st
End Sub
'============================================================
Sub test3(out_time, cnt)
'Asakiさんのコードをちょっと変更してループをなくしたコード
st = Now()
Dim ans As Range
Dim rng As Range
Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
ad = rng.Address
With Range("e1:e" & cnt)
.Formula = "=if(CountIf(" & ad & ",Row())=0,row(),"""")"
.Value = .Value
On Error Resume Next
Set ans = .SpecialCells(xlCellTypeConstants)
If Err.Number = 0 Then
ans.Copy Range("d1")
End If
.ClearContents
End With
Set rng = Nothing
out_time = Now() - st
End Sub
'====================================================================
Sub test4(out_time, cnt)
'つんさんのコード
st = Now()
Dim i As Long
Dim r As Range
Dim rTarget As Range
Set rTarget = Range(Cells(1, 1), Cells(Range("a65536").End(xlUp).Row, 1))
For i = 1 To cnt
Set r = rTarget.Find(i, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True)
If r Is Nothing Then
Cells(j + 1, 5).Value = i
j = j + 1
End If
Next i
Set r = Nothing
Set rTarget = Nothing
out_time = Now() - st
End Sub
'==================================================================
Sub test5(out_time, cnt)
'Evaluateメソッドで配列を使用したコード
st = Now()
Dim rng As Range
Dim ans
Set rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
ad = rng.Address
ans = Evaluate("transpose(if(countif(" & ad & _
",row(a1:a" & cnt & "))=0,row(a1:a" & cnt & "),""×""))")
wk = Filter(ans, "×", False)
i = 1
For Each a In wk
Cells(i, 6).Value = a
i = i + 1
Next
Set rng = Nothing
out_time = Now() - st
End Sub
'=====================================================================
Sub test6(out_time, cnt)
'Countifでべたで数えた方法
st = Now()
Dim i As Long
Dim r As Range
Dim rTarget As Range
Set rTarget = Range(Cells(1, 1), Cells(Range("a65536").End(xlUp).Row, 1))
With WorksheetFunction
For i = 1 To cnt
If .CountIf(rTarget, i) = 0 Then
Cells(j + 1, 7).Value = i
j = j + 1
End If
Next i
End With
Set rTarget = Nothing
out_time = Now() - st
End Sub
というコードで実験してみました。
Findメソッドは、文字列比較をするので処理自体は遅いかも・・・
という予想（中身は知らないので根拠はありませんが）をしていました。
途中で終わらせたのでそこまでの結果ですが、以下のようになっています。
データ数 test1 test2 test3 test4 test5 test6 欠番数
100 0:00:01 0:00:00 0:00:00 0:00:00 0:00:01 0:00:00 35
1100 0:00:04 0:00:04 0:00:02 0:00:08 0:00:04 0:00:04 412
2100 0:00:11 0:00:11 0:00:06 0:00:17 0:00:11 0:00:11 794
3100 0:00:19 0:00:20 0:00:13 0:00:31 0:00:19 0:00:20 1162
4100 0:00:31 0:00:32 0:00:23 0:00:49 0:00:31 0:00:32 1509
5100 0:00:44 0:00:45 0:00:34 0:01:09 0:00:44 0:00:46 1881
6100 0:01:00 0:01:01 0:00:49 0:01:35 0:01:00 0:01:03 2231
7100 0:01:21 0:01:22 0:01:08 0:02:04 0:01:21 0:01:23 2613
8100 0:01:49 0:01:46 0:01:31 0:02:38 0:01:45 0:01:50 2999
9100 0:02:12 0:02:12 0:01:55 0:03:13 0:02:11 0:02:14 3357
10100 0:02:44 0:02:42 0:02:22 0:03:53 0:02:42 0:02:45 3701
11100 0:03:14 0:03:14 0:02:54 0:04:34 0:03:13 0:03:18 4118
12100 0:03:50 0:03:49 0:03:28 0:05:16 0:03:50 0:03:53 4432
13100 0:04:31 0:04:32 0:04:07 0:06:06 0:04:28 0:04:35 4825
14100 0:05:14 0:05:12 0:04:47 0:06:58 0:05:11 0:05:16 5135
15100 0:06:01 0:06:03 0:05:34 0:07:57 0:05:59 0:06:04 5566
16100 0:06:53 0:06:56 0:06:26 0:08:55 0:06:52 0:06:58 5946
計 ***** ***** ***** ***** ***** ***** *****
137700 0:40:39 0:40:41 0:36:19 0:56:03 0:40:22 0:41:12 50716
速度順位 3 4 1 6 2 5
以上が途中までの結果ですが、
一応、処理速度の順位は付けましたが、「大きい変化はないなあ」
というのが私の感想でした。
それにデータ数がこれ以上に大きくなったとき、配列を使った手法はExcelが
我慢できるかという懸念もあります。
尚、実験は、win98se & Excel2000で行いました。
PCのスペックによって数値が違うのは当然ですが、
結果からの考察をよかったらしてみて下さい。
|
|
ichinose
- 04/8/5(木) 8:49 -
