[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『コードの改善』(T16)
お世話になります。
下記のコードより処理速度を“速く”できないかご教授願います。
「Dictionary」を使用したのを作成してみましたが、逆に遅くなり
頓挫しています。(記述のしかたが悪いのだと思われます)
コード説明)
・B列とAP列以降がデータ列です
・B列にある名前(重複なし)とAP列にある名前(重複あり)が一致した場合に
AF列にある値を合計し、AW列他がある条件を満足する場合にポイントを与えて
それらを合計し、AD列に出力します
・maxc,maxb は最終行です
Set rad = Range(Cells(2, "AD"), Cells(maxc, "AD"))
Set raf = Range(Cells(2, "AF"), Cells(maxb, "AF"))
Set rap = Range(Cells(2, "AP"), Cells(maxb, "AP"))
Set ras = Range(Cells(2, "AS"), Cells(maxb, "AS"))
Set raw = Range(Cells(2, "AW"), Cells(maxb, "AW"))
Set rbd = Range(Cells(2, "BD"), Cells(maxb, "BD"))
Set rbf = Range(Cells(2, "BF"), Cells(maxb, "BF"))
vad = rad.Value
i = 0
With WorksheetFunction
For j = 2 To maxc
i = i + 1
nmB = Cells(j, "B").Value
vad(i, 1) = .SumIf(rap, nmB, raf)
vad(i, 1) = vad(i, 1) + .CountIfs(rap, nmB, raw, "<0.6", rbf, "NI") * 0.5
vad(i, 1) = vad(i, 1) + .CountIfs(rap, nmB, raw, "<0.6", rbf, "SE") * 0.5
vad(i, 1) = vad(i, 1) + .CountIfs(rap, nmB, ras, "<6", rbd, ">9") * 0.5
Next
End With
rad.Value = vad
元々は関数式であったのを処理速度対策でマクロ化をご教授いただき劇的に
速くなりましたが、それでも5〜10秒かかっておりさらなる改善を模索しています..
よろしくお願いいたします。
(今から外出で返信遅れますこと、お許し願います)
< 使用 Excel:Excel2010、使用 OS:Windows7 >
どうもよくわかりません。
>>B列とAP列以降がデータ列です
コードでは AD列やAF列も登場していますが?
>>「Dictionary」を使用したのを作成してみましたが、逆に遅くなり 頓挫しています。
このコードのどこで Dictionary を使っているのですか? 使っていませんが?
★maxc や maxb、列のデータ最終行だと思いますが、それぞれ、値を取得しているところも参考までにみたいです。 ということもありますが、なにより、質問されている Dictionary の影も形も見えない?
Sub から End Sub まで、すべてを、そのまま、コピペでアップいただけませんか?
(β) 2016/09/27(火) 11:45
先ほどからコードをおいかけて、やろうとしている要件を理解しようとしているのですが・・
アップされたコードを疑うわけではありませんが、仮に
A列に 田中 があった。 AP列に 田中 が 3件あった。そのどれもが AF列が10、AW列が0.2、BF列が「NI」だったとしたら AD列の 田中 の行は、どんな数値になりますか?
(β) 2016/09/27(火) 18:21
こんばんわ。
これってB列とAP列はそれぞれ何行くらいデータがあるんですか?
B列に重複が無いので、Dictionaryで集計するなら格納しながら加算すると言う方法になると思いますが、 AP列をソート出来るなら配列を使うと言う方法もあります。 どちらが早いかは実際にコードを書いてみないと分かりませんが、どちらの方法でも 範囲を値で取得した方がRangeオブジェクトで取得するより早くなります。
もう一つの方法は、集計範囲が広いと関数は遅くなるので、nmB以外は固定の条件見たいですので、 範囲を限定してCOUNTIFSではなくCOUNTIFで集計できるように、フィルターオプションで、 範囲を別シートにでも抽出してから、数式をセットするかですね。
ただデータ数や内容によるので、どの方法でも今より早くなるかは分かりません。 また他に関数がセットされていたりしたら足を引っ張るので、テストするなら他の関数を全て値に変更してから実行しないと、 一番早い方法は検証できません。
(sy) 2016/09/27(火) 18:45
ちょっと思ったんですけど、 ご提示のコードは1行ずつ関数で計算した値をセットしてるので、 一括で関数をセットした方が早いんじゃないかと思うんですが? 以下のコードでは今より遅いですか?
Sub test() Dim rngB As Range Dim rngAP As Range Dim rngAD As Range Dim adAP As String Dim adAF As String Dim adAS As String Dim adAW As String Dim adBD As String Dim adBF As String Dim t As Double
t = Timer
Range("AD2:AD" & Rows.Count).ClearContents Set rngB = Range("B2", Range("B" & Rows.Count).End(xlUp)) Set rngAD = rngB.Offset(, 28) Set rngAP = Range("AP2", Range("AP" & Rows.Count).End(xlUp)) adAP = rngAP.Address adAF = rngAP.Offset(, -10).Address adAS = rngAP.Offset(, 3).Address adAW = rngAP.Offset(, 7).Address adBD = rngAP.Offset(, 14).Address adBF = rngAP.Offset(, 16).Address
rngAD.Formula = "=SUMIF(" & adAP & ",B2," & adAF & ")" & _ "+COUNTIFS(" & adAP & ",B2," & adAW & ",""<0.6""," & adBF & ",""NI"")/2" & _ "+COUNTIFS(" & adAP & ",B2," & adAW & ",""<0.6""," & adBF & ",""SE"")/2" & _ "+COUNTIFS(" & adAP & ",B2," & adAS & ",""<6""," & adBD & ","">9"")/2" rngAD.Value = rngAD.Value
Debug.Print "関数セット: " & Timer - t
End Sub
(sy) 2016/09/27(火) 20:22
返事が無いのでよく分からないけど、書いてたので配列でのコード載せておきます。 補足(7:05) 忘れてましたB列、AP列でそれぞれデータが並び替えられてないといけません。
Sub test2() Dim i As Long Dim j As Long Dim v() As Variant Dim rb As Variant Dim raf As Variant Dim rap As Variant Dim ras As Variant Dim raw As Variant Dim rbd As Variant Dim rbf As Variant Dim t As Double
t = Timer
i = Range("B" & Rows.Count).End(xlUp).Row rb = Range("B2:B" & i).Value ReDim v(1 To i - 1, 0)
i = Range("AP" & Rows.Count).End(xlUp).Row raf = Range("AF2:AF" & i).Value rap = Range("AP2:AP" & i).Value ras = Range("AS2:AS" & i).Value raw = Range("AW2:AW" & i).Value rbd = Range("BD2:BD" & i).Value rbf = Range("BF2:BF" & i).Value
i = 1 j = 1 Do Until i > UBound(rb, 1) If rb(i, 1) = rap(j, 1) Then v(i, 0) = v(i, 0) + raf(j, 1) If raw(j, 1) < 0.6 And (rbf(j, 1) = "NI" Or rbf(j, 1) = "SE") Then v(i, 0) = v(i, 0) + 0.5 If ras(j, 1) < 6 And rbd(j, 1) > 9 Then v(i, 0) = v(i, 0) + 0.5 j = j + 1 If j > UBound(rap, 1) Then Exit Do Else i = i + 1 End If Loop Range("AD2:AD" & Rows.Count).ClearContents Range("AD2").Resize(UBound(v, 1)).Value = v
Debug.Print "配列: " & Timer - t
End Sub
(sy) 2016/09/28(水) 06:43
Sub test3() Dim i As Long Dim j As Long Dim dic As Object Dim v() As Variant Dim rb As Variant Dim raf As Variant Dim rap As Variant Dim ras As Variant Dim raw As Variant Dim rbd As Variant Dim rbf As Variant Dim t As Double
t = Timer
i = Range("B" & Rows.Count).End(xlUp).Row rb = Range("B2:B" & i).Value ReDim v(1 To i - 1, 0)
i = Range("AP" & Rows.Count).End(xlUp).Row raf = Range("AF2:AF" & i).Value rap = Range("AP2:AP" & i).Value ras = Range("AS2:AS" & i).Value raw = Range("AW2:AW" & i).Value rbd = Range("BD2:BD" & i).Value rbf = Range("BF2:BF" & i).Value
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(rb, 1) dic(rb(i, 1)) = 0 Next i For i = 1 To UBound(rap, 1) If dic.Exists(rap(i, 1)) Then dic(rap(i, 1)) = dic(rap(i, 1)) + raf(i, 1) If raw(i, 1) < 0.6 And (rbf(i, 1) = "NI" Or rbf(i, 1) = "SE") Then dic(rap(i, 1)) = dic(rap(i, 1)) + 0.5 End If If ras(i, 1) < 6 And rbd(i, 1) > 9 Then dic(rap(i, 1)) = dic(rap(i, 1)) + 0.5 End If End If Next i
For i = 1 To UBound(rb, 1) v(i, 0) = dic.Item(rb(i, 1)) Next i Range("AD2:AD" & Rows.Count).ClearContents Range("AD2").Resize(UBound(v, 1)).Value = v
Debug.Print "Dictionary: " & Timer - t
End Sub
(sy) 2016/09/28(水) 07:35
既出ですけど、私もDictionaryで書いてみました。
データ件数によっては sy さん指摘の通り、セルオブジェクト直接参照ではなく、配列に取り込んだものを 処理したほうが早いのですが、とりあえず。
なお、計算結果を、どう丸めるのか、丸めないのかによって、結果がちょっと変わってくるとは思いますが。
Sub Sample() Dim c As Range Dim dic As Object Dim ans As Object Dim n As Long Dim w As Variant
Set dic = CreateObject("Scripting.Dictionary") Set ans = CreateObject("Scripting.Dictionary")
For Each c In Range("AP2", Range("AP" & Rows.Count).End(xlUp)) If Not dic.Exists(c.Value) Then dic(c.Value) = Array(0, 0, 0, 0) w = dic(c.Value) If c.EntireRow.Range("AW1").Value < 0.6 Then Select Case c.EntireRow.Range("BF1").Value Case "NI" w(0) = w(0) + 1 Case "SE" w(1) = w(1) + 1 End Select End If If c.EntireRow.Range("AS1").Value < 6 And c.EntireRow.Range("BD1").Value >= 9 Then w(2) = w(2) + 1 w(3) = w(3) + c.EntireRow.Range("AF1").Value dic(c.Value) = w Next
For Each c In Range("B2", Range("B" & Rows.Count).End(xlUp)) n = 0 If dic.Exists(c.Value) Then w = dic(c.Value) n = (w(0) + w(1) + w(2)) * 0.5 + w(3) End If ans(ans.Count) = n Next
Range("AD2").Resize(ans.Count).Value = WorksheetFunction.Transpose(ans.items)
End Sub
(β) 2016/09/28(水) 09:30
test()=3.93, test2()=0.03, test3()=0.06, Sample()=0.48
(3回実行のmax値です)
※書かれていますようにSample()の結果は一致していませんが、
そのまま実行しています
※AD列のみの実行結果です(追記)
20近くある関数式をひとつのマクロで実行するようにしており、
他列への応用を図るべく勉強させていただきます。
コード理解はこれからですが、おそらく躓きそうです..
これからもよろしくお願いいたします。
(T16) 2016/09/28(水) 14:40
>>Sample()の結果は一致していませんが
でしょうね。計算ロジックは、あまりよく精査というか、そちらのコードをかみ砕いて分析していませんので。 あくまで Dictionary処理のサンプルとして見ていただければと思います。
もちろん、計算ロジックもちゃんとしたものにしたいので、(β) 2016/09/27(火) 18:21 で質問していることへの 回答をもらえたらありがたいですが。
(β) 2016/09/28(水) 15:04
私が作成したDic..を使用したコードは使いものにならないので
掲載しませんでした。
回答いただいたコードを参考にどこがダメなのか考えます。
(For文で一行ずつ処理しているからだと思いますが..)
これも行詰ったら再質問させていただきたく...
よろしくお願いいたします。
(T16) 2016/09/28(水) 16:47
例示の結果、31.5 了解です。 私のコードの Dim n As Long 、これを Dim n As Double にすればOKになるかと思います。
(β) 2016/09/28(水) 19:59
お二人のコードで改善効果「大」なることは計測値を見るまでもなく
“体感”できて嬉しいかぎりですが、以下お尋ねします。
1.「test2()」と「test3()」の処理速度の差は「Loop1回」と「For2回」の
ループ処理?の回数の差が(他の差異より)貢献が大でしょうか?
あるいは、差は誤差の範囲内と考えるべきでしょうか?
2.「test3()」と「Sample()」の速度の差はどこにあるのでしょうか?
3.「Sample()」の「Transpose」は「Ans」のデータが“横配列”になっている
からでしょうか???(なぜ必要なんでしょうか?)
4.「範囲を値で取得した方が...早くなる」とのことですが、具体的には
「test2()」の「raf」以下の「Range(..).Value」の箇所でしょうか?
5.拙作との差はズバリここでしょうか?
ピント外れかと思いますが、よろしくお願いいたします。
(T16) 2016/09/29(木) 13:49
βのコードに関するところだけコメントします。
2. test3()とSample() の構成はそんなに変わらないと思いますが、相当、処理時間に違いがありますか? 3.DictionaryやArrayListのデータを配列に取り出すと、1次元配列、つまり横に伸びる配列になっています。 ですから、縦に落とし込むために Transpose をかけています。 4.セルオブジェクトの参照と、メモリー内の値そのものの参照。 データボリュームが膨大であれば差がでてくるかと思いますが、全体から見れば大きな影響はないと思います。 でも、理屈としては、セルオブジェクトを参照した場合は、そのオブジェクトがどこに存在するか、オブジェクトのチェーンをたどりながら 探し出し、そこの値を参照。一方、配列等に取り込んだものは、どこにあるかがピンポイントでわかっているので アドレッシングが早いということはいえます。 膨大なデータ件数であれば、この【チリ】が【チリも積もれば・・】になります。
で、そちらのコード、動かしてはいませんが、どちらかというと、1行に対してワークシート関数を4回使っている、 そのあたりが大きいのでは?
(β) 2016/09/29(木) 14:49
>test3()とSample() の構成はそんなに変わらない..処理時間に違い.. ↓ 「Timer」での結果は先述しました、0.06と0.48です。 実用上問題ないですが、理屈上どうなのかと思ったしだいです。
>1行に対してワークシート関数を4回使っている、そのあたりが大きい.. ↓ 確かに「test()」も3.93秒かかっていますので、本例ではワークシート関数は 使わない方がベターである..との理解でよろしいでしょうか? (T16) 2016/09/29(木) 16:40
>>「Timer」での結果は先述しました、0.06と0.48です。
syさんのコード、細かくは見ていませんが、コメントした、セルオブジェクト参照と配列内参照の違いかもしれませんね。
>>使わない方がベターである..との理解でよろしいでしょうか?
VBAコードでゴリゴリ、ループ処理をさせるより、シート関数利用で、さくっと値を取得するほうが早いことが多いですから 効率的に使うということは、むしろ、積極的に取り入れられたらいいと思います。
ただ、これは syさんのコメントにもありましたが、同じ値の取得を1行あたり、複数回おこない、かつ 毎行、それを行っているというあたりが原因だと思います。
(β) 2016/09/29(木) 21:42
こんばんわ。
1,2,4に関してだけ、長くなりすぎたので設問ごとに分けます。
1に関してですけど、test3がtest2より遅いのはループ回数の差なんですけど、本質はB列とAP列が同じ値かどうかを判定する為の検索方法の違いだと思います。
test2は、B列とAP列が共に昇順(降順)同じ並びで、ソートされていないと使えません。 test3は並びがバラバラでも大丈夫です。
以下のtest4は並びがバラバラの時の配列での方法ですが、実行すれば分かりますが、test3の方が圧倒的に早いです。 ソートもコードに組み込めばもっと早いですけど、レイアウトが分からないので今回は書けませんでした。 それでもソート2回実行する処理時間だけで、test3の総時間を超えると思います。
Dictionaryの内部ロジックは分かりませんが、コンパイラ言語で書かれたコードなので、同じ方法だとしてもVBAで書く配列コードよりも圧倒的に早いです。
Excelの機能や関数、VBAで使用できるオブジェクトの方が、配列より早く処理できる事は多いと思います。 (そう言う私も最近まで配列は万能道具と思ってたんですけど) (関数は非常に高速ですが、1セル毎に範囲を参照するので、セットするセルが多いと参照範囲×セル数になるので遅くなります。 1セルだけとかなら、よほど複雑で参照範囲が広い数式とかでも無い限り最速と思います。 今回の要件ではセットするセルが多いのと、式も複数で参照範囲が多いので向いてないですね。)
test2は、予め並び順を合わせて最小限のループ回数になるようなデータ、と言う限定的な条件が揃えば、 配列は凄く早く処理が出来る事もあると言う1例です。
(sy) 2016/09/29(木) 22:09
2は4の理由が大きいと思います。 test5とtest6は、配列とDictionaryのコードをセル参照にした以外に違いはありませんが、比べるとかなり遅い事が分かると思います。 βさんからもありましたけど追加で、 値参照はそのインデックス番号の値がそのままのデータですけど、セル参照の場合.Valueで指定したプロパティを沢山あるプロパティやメソッドの中からセレクトして、 プロパティである値をオブジェクトから取り出して初めて値が参照できるので、 途中に無駄な手順が多いため値参照より数倍遅くなるんだと思ってます。 (私の認識が全て合ってるかは自信無いですけど)
まぁでも今回の1回の実行に関して言えば、0.06秒と0.48秒に体感的な差は無いですね。 ただ最終目標の20個関数を置き換えるとなれば、1.2秒と9.6秒ではそれなりの差になると思います。 またデータ量が多くなればなるほど、倍数なので差は非常に大きくなります。
後もう一つは、Existsの重複判定が1回か2回の差もあると思います。 私の体感的に、Existsの判定は単に格納するだけと比べたら、結構時間かかる処理だと思うので、 今回のようにB列に重複が無いのであれば、先にB列を格納して重複判定は1回で済ます方が早いと思います。
(sy) 2016/09/29(木) 22:11
追加コードです。 すいません。 一部修正(22:35)
Sub test4() Dim i As Long Dim j As Long Dim v() As Variant Dim rb As Variant Dim raf As Variant Dim rap As Variant Dim ras As Variant Dim raw As Variant Dim rbd As Variant Dim rbf As Variant Dim t As Double
t = Timer
i = Range("B" & Rows.Count).End(xlUp).Row rb = Range("B2:B" & i).Value ReDim v(1 To i - 1, 0)
i = Range("AP" & Rows.Count).End(xlUp).Row raf = Range("AF2:AF" & i).Value rap = Range("AP2:AP" & i).Value ras = Range("AS2:AS" & i).Value raw = Range("AW2:AW" & i).Value rbd = Range("BD2:BD" & i).Value rbf = Range("BF2:BF" & i).Value
For i = 1 To UBound(rb, 1) For j = 1 To UBound(rap, 1) If rb(i, 1) = rap(j, 1) Then v(i, 0) = v(i, 0) + raf(j, 1) If raw(j, 1) < 0.6 And (rbf(j, 1) = "NI" Or rbf(j, 1) = "SE") Then v(i, 0) = v(i, 0) + 0.5 If ras(j, 1) < 6 And rbd(j, 1) > 9 Then v(i, 0) = v(i, 0) + 0.5 End If Next j Next i Range("AD2:AD" & Rows.Count).ClearContents Range("AD2").Resize(UBound(v, 1)).Value = v
Debug.Print "配列全検索: " & Timer - t
End Sub
Sub test5() Dim i As Long Dim j As Long Dim v() As Variant Dim rb As Range Dim raf As Range Dim rap As Range Dim ras As Range Dim raw As Range Dim rbd As Range Dim rbf As Range Dim t As Double
t = Timer
i = Range("B" & Rows.Count).End(xlUp).Row Set rb = Range("B2:B" & i) ReDim v(1 To i - 1, 0)
i = Range("AP" & Rows.Count).End(xlUp).Row Set raf = Range("AF2:AF" & i) Set rap = Range("AP2:AP" & i) Set ras = Range("AS2:AS" & i) Set raw = Range("AW2:AW" & i) Set rbd = Range("BD2:BD" & i) Set rbf = Range("BF2:BF" & i)
i = 1 j = 1 Do Until i > rb.Count If rb(i, 1).Value = rap(j, 1).Value Then v(i, 0) = v(i, 0) + raf(j, 1).Value If raw(j, 1).Value < 0.6 And (rbf(j, 1).Value = "NI" Or rbf(j, 1).Value = "SE") Then v(i, 0) = v(i, 0) + 0.5 If ras(j, 1).Value < 6 And rbd(j, 1).Value > 9 Then v(i, 0) = v(i, 0) + 0.5 j = j + 1 If j > rap.Count Then Exit Do Else i = i + 1 End If Loop Range("AD2:AD" & Rows.Count).ClearContents Range("AD2").Resize(UBound(v, 1)).Value = v
Debug.Print "配列セル参照: " & Timer - t
End Sub
Sub test6() Dim i As Long Dim j As Long Dim dic As Object Dim v() As Variant Dim rb As Range Dim raf As Range Dim rap As Range Dim ras As Range Dim raw As Range Dim rbd As Range Dim rbf As Range Dim t As Double
t = Timer
i = Range("B" & Rows.Count).End(xlUp).Row Set rb = Range("B2:B" & i) ReDim v(1 To i - 1, 0)
i = Range("AP" & Rows.Count).End(xlUp).Row Set raf = Range("AF2:AF" & i) Set rap = Range("AP2:AP" & i) Set ras = Range("AS2:AS" & i) Set raw = Range("AW2:AW" & i) Set rbd = Range("BD2:BD" & i) Set rbf = Range("BF2:BF" & i)
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To rb.Count dic(rb(i, 1).Value) = 0 Next i For i = 1 To rap.Count If dic.Exists(rap(i, 1).Value) Then dic(rap(i, 1).Value) = dic(rap(i, 1).Value) + raf(i, 1).Value If raw(i, 1).Value < 0.6 And (rbf(i, 1).Value = "NI" Or rbf(i, 1).Value = "SE") Then dic(rap(i, 1).Value) = dic(rap(i, 1).Value) + 0.5 End If If ras(i, 1) < 6 And rbd(i, 1) > 9 Then dic(rap(i, 1).Value) = dic(rap(i, 1).Value) + 0.5 End If End If Next i
For i = 1 To rb.Count v(i, 0) = dic.Item(rb(i, 1).Value) Next i Range("AD2:AD" & Rows.Count).ClearContents Range("AD2").Resize(UBound(v, 1)).Value = v
Debug.Print "Dictionaryセル参照: " & Timer - t
End Sub
(sy) 2016/09/29(木) 22:13
> 私の体感的に、Existsの判定は単に格納するだけと比べたら、結構時間かかる処理だと思うので、
ここの部分だけなんですけど、本当なんですかねぇ。 体感したのなら本当なんでしょうけど、理屈には合わない気がします。
単に格納なんてしていないと思います。
どこに格納するか判断しているハズです。 じゃなきゃDictionaryと言えません。
それによって素早く取り出すことができるようになる。 Existの判定も同じく判断しやすくなる。
理屈としては、格納の方が遅い、となるハズと思っちゃいますね。
<追記> Existを判断して、また取出して、だと2倍近く掛かるかも知れません。
(半平太) 2016/09/29(木) 23:28
すいません。 半平太さんのおっしゃる通りでした。
感覚だけではいけないので一応テストはしたんですが、テストコードに問題がありました。 以下のようなコードでテストしてみたんですが、
Sub test() Dim dic As Object Dim r As Range Dim c As Range Dim i As Long Dim t As Double Dim buf As Variant
For i = 1 To 9999 Cells(i, 1).Value = "A" & Format(i, "0000") Next i
Set dic = CreateObject("Scripting.Dictionary")
Set r = Range("A1").CurrentRegion
t = Timer For Each c In r If Not dic.Exists(c.Value) Then dic(c.Value) = c.Value Next c buf = "Existsあり " & Int((Timer - t) * 1000) / 1000 & ":Existsなし "
t = Timer For Each c In r dic(c.Value) = c.Value Next c Debug.Print buf & Int((Timer - t) * 1000) / 1000
End Sub
1,Existsあり 0.109:Existsなし 0.062 2,Existsあり 0.101:Existsなし 0.054 3,Existsあり 0.101:Existsなし 0.062 4,Existsあり 0.101:Existsなし 0.062 5,Existsあり 0.109:Existsなし 0.054 6,Existsあり 0.109:Existsなし 0.054 7,Existsあり 0.109:Existsなし 0.054 8,Existsあり 0.101:Existsなし 0.062 9,Existsあり 0.101:Existsなし 0.062 10,Existsあり 0.109:Existsなし 0.062
この結果で、判定なしの方が早いと思ってましたが、順番変えたら逆転しました。 今までにコード書いて遅いと思ってたのは、IFで判定してる分遅くなるだろうとの思い込みから感じてただけかも知れません。 1,Existsなし 0.063:Existsあり 0.048 2,Existsなし 0.061:Existsあり 0.048 3,Existsなし 0.065:Existsあり 0.048 4,Existsなし 0.061:Existsあり 0.054 5,Existsなし 0.059:Existsあり 0.048 6,Existsなし 0.059:Existsあり 0.052 7,Existsなし 0.064:Existsあり 0.047 8,Existsなし 0.065:Existsあり 0.046 9,Existsなし 0.062:Existsあり 0.047 10,Existsなし 0.061:Existsあり 0.048
どう言うコードなら純粋な速度比較が出来るんだろう?
(sy) 2016/09/30(金) 00:17
ただ疑問に思うのは、
格納する時にデータベースのようにインデックスを付けて格納してると思うのですが、 それはIf Not Exists thenでTrueになった後にも行われてると思うのですが?
だとすれば重複が1つも無いデータだと、判定の分だけ余分に処理してると思うんですが?
根本的に勘違いしてるのかな?
(sy) 2016/09/30(金) 00:25
よくよく考えたらこう言うコードにしないといけなかった。
Sub test() Dim dic1 As Object Dim dic2 As Object Dim r As Range Dim c As Range Dim i As Long Dim t As Double Dim buf As Variant
For i = 1 To 9999 Cells(i, 1).Value = "A" & Format(i, "0000") Next i
Set dic1 = CreateObject("Scripting.Dictionary") Set dic2 = CreateObject("Scripting.Dictionary")
Set r = Range("A1").CurrentRegion
t = Timer For Each c In r If Not dic2.Exists(c.Value) Then dic2(c.Value) = c.Value Next c buf = "Existsあり " & Int((Timer - t) * 1000) / 1000 & ":Existsなし "
t = Timer For Each c In r dic1(c.Value) = c.Value Next c Debug.Print buf & Int((Timer - t) * 1000) / 1000
End Sub
1,Existsあり 0.102:Existsなし 0.062 2,Existsあり 0.104:Existsなし 0.06 3,Existsあり 0.104:Existsなし 0.06 4,Existsあり 0.106:Existsなし 0.061 5,Existsあり 0.105:Existsなし 0.063
1,Existsなし 0.063:Existsあり 0.102 2,Existsなし 0.066:Existsあり 0.107 3,Existsなし 0.062:Existsあり 0.104 4,Existsなし 0.063:Existsあり 0.103 5,Existsなし 0.064:Existsあり 0.107
この結果だけ見ると、単に格納するだけの方が早いと思います。
(sy) 2016/09/30(金) 01:05
>この結果だけ見ると、単に格納するだけの方が早いと思います。
syさん
おっしゃる通りです。
私に勘違がありました。申し訳ありません。m(__)m
(半平太) 2016/09/30(金) 08:46
今回、私なりの教訓としましては以下ぐらいが精一杯です..T T
・可能なかぎりソートする
・処理の「回数」をいかに減らせるかを考える
新たな疑問も湧いてきましたが、本筋とはちょっと外れるようなのと
長くなってきましたので、新規にアップしたいと考えます。
よろしくお願いいたします。
(T16) 2016/09/30(金) 09:17
言っていることと、検証データが違いますよね?
そもそもの比較は、Dictionayへの格納とExistsの判定の
比較ですよね?
検証では判定後格納している状態ではないですか?
もともとの比較で行うとするなら、Existsの時間から格納分
時間を引く必要があります。
それを加味すると、Existsのコストのほうが低いと思いますが
どうでしょう?
(ねこの手@モバイル) 2016/09/30(金) 10:08
To ねこの手@モバイルさん
話の本題は重複の無いデータの格納方法ですよ。 Existsありなしで格納まで行った時の時間の話です。
>もともとの比較で行うとするなら、Existsの時間から格納分時間を引く必要があります。
判定のみでデータの格納を行わなければ、コードとしてなんの役にも立たないので、無意味じゃないですか?
(sy) 2016/09/30(金) 11:10
だって例えるなら、一つ口のコンロでラーメン(Dictionaryへのセット)を作る時間と
ラーメンとチャーハン(Exists)と餃子(if)を作る時間のどちらが時間がかかるかを
検証するんですから、検証するまでもないですよね?
以下の比較ってことでしょ?
1は2の構文をそのまま含んでますよね?
1 If Not dic2.Exists(c.Value) Then dic2(c.Value) = c.Value
2 dic1(c.Value) = c.Value
(ねこの手@モバイル) 2016/09/30(金) 11:28
Dictionary の内部実装がどうなっているか、もちろんわからないのですが、別の例で、たとえば正規表現。
βは、ずっと(くせが抜けず今でも)Execute を行い、その結果の Count が 0 かどうかで処理分岐させていました。 一方、ほかの回答者さんから まず、Test を行い、その Test結果で、該当ケースがあるなら Executeするというコードがアップされました。
最初は、正規表現処理を2回(TextとExecute)かけるのは無駄じゃないのかなぁと、そう思ったんですが あるケースで計測すると、Text+Executeのほうが Execute一本より効率がいいという結果でした。
もちろん、マッチするものが、データの中の、ほんの一部なのか、大部分なのか、そういうことによって 異なってくると思いますけど、想像するに Text は、ExecuteのFullロジックの、ごく一部を使っているんだろうなと。
そう考えると、Dictionaryにおいても、Existsメソッドは、書き込み機能で行っている処理の中の、ごく一部のみを 行っているかもしれません。(いやいや、大部分を実行している とうことかもしれませんけど) ごく一部だったとすれば、事前のExistsも効果があるのかもしれません。
いずれにしても、前述しましたように、データ的に、ほとんどマッチ、不合は例外 なのか ほとんどアンマッチ、ほんの一部がマッチ なのかにより、かわってくるものだと思います。
(β) 2016/09/30(金) 13:22
>であれば検証自体が無意味だと思いますよ?
そうですね。
私も上の方で >格納する時にデータベースのようにインデックスを付けて格納してると思うのですが、 >それはIf Not Exists thenでTrueになった後にも行われてると思うのですが? >だとすれば重複が1つも無いデータだと、判定の分だけ余分に処理してると思うんですが? と言ってるように、無しの方が早いと思ってます。
ただ私は今までDictionaryは殆ど使った事が無くて(実務では一度もなし)、内部のロジックがどうか分からないので、 念の為自分で確認するように検証コードを書いただけで、指摘を受けなければUPするつもりも無かったので。
>データ的に、ほとんどマッチ、不合は例外 なのか >ほとんどアンマッチ、ほんの一部がマッチ なのかにより、かわってくるものだと思います。 私もそう思います。 まぁ重複があればそもそも使う以外に選択肢が無いですけど、 重複が無いのが分かってる場合は使わない方が良いですね。
(sy) 2016/10/01(土) 13:16
・B列にある名前(重複なし)とAP列にある名前(重複あり)が一致した場合に
何をやりたいかさっぱりわかりませんが、
B列にある名前でオートフィルター掛けて抽出できたものに、
なにかしたらいいのかなぁ?
B列とD,E,F列くらいで、サンプルデータ作って練習してみた方が、
だれもが解りやすいんじゃないかなぁ。。。。?
(まっつわん) 2016/10/01(土) 14:15
まっつわんさん
(sy) 2016/09/29(木) 22:13 までが本題です。
これ以降の討論は、 >私の体感的に、Existsの判定は単に格納するだけと比べたら、結構時間かかる処理だと思うので、 の私の文章が誤解を生みやすかったんだと反省していますが、
単にDictionaryに格納するのに、重複の無いデータの場合Existsのあるなしで、どっちが早いかとそれだけの内容です。 本題とは完全に外れてしまっているので、もうそれ以上の意味は無い話になっています。 結果重複が無い場合は、Existsは使わない方が格納が早いと言う事で落ち着た話だと思っています。
本題の方でもっと良い方法があるのでしたら、提示して頂ければ質問者さんの糧になると思いますが、 以降の話に関しては、もうこのレスを最後に私からは終わりにしたいと思います。
(sy) 2016/10/01(土) 15:39
あぁ、そうなんですね。。。了解です。
(まっつわん) 2016/10/01(土) 16:59
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.