[[20160927112823]] 『コードの改善』(T16) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『コードの改善』(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


Dictionaryのコードも書いてみましたこちらは並べ替えの必要はありません。

 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


β様、sy様
ありがとうございます、 また拙い説明スミマセンでした。
十分な確認時間がとれないため結果のみ報告させていただきます。

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


β様
お手数かけました、 ご質問の例では「31.5」になります。
(10*3コ+0.5*3コ)
またコードを丸ごと提示は長文であることと編集すると誤記が
心配で省いてしまいました、 お許しください。

私が作成したDic..を使用したコードは使いものにならないので
掲載しませんでした。
回答いただいたコードを参考にどこがダメなのか考えます。
(For文で一行ずつ処理しているからだと思いますが..)
これも行詰ったら再質問させていただきたく...
よろしくお願いいたします。
(T16) 2016/09/28(水) 16:47


 例示の結果、31.5 了解です。
 私のコードの Dim n As Long 、これを Dim n As Double にすればOKになるかと思います。

(β) 2016/09/28(水) 19:59


β様、 ありがとうございます。
問題なきこと確認しました。(BD列判定の箇所は「>9」に修正しました)

お二人のコードで改善効果「大」なることは計測値を見るまでもなく
“体感”できて嬉しいかぎりですが、以下お尋ねします。
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


β様、sy様、半平太様
いろいろ教えていただきありがとうございます。
ただ、「セルオブジェクトの参照とメモリー内の値そのものの参照」とか
「格納」とか、後半の部分は正直ついていけてません..^ ^;

今回、私なりの教訓としましては以下ぐらいが精一杯です..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


> 単にDictionaryに格納するのに、重複の無いデータの場合Existsのあるなしで、どっちが早いかとそれだけの内容です。

あぁ、そうなんですね。。。了解です。
(まっつわん) 2016/10/01(土) 16:59


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.