[[20191031205758]]　『vbaで条件分岐のコードを高速化する方法』（むーす）　ページの最後に飛ぶ

『vbaで条件分岐のコードを高速化する方法』（むーす）

Ｄ列＝数値
Ｅ列＝（Ｄ列の下のセルー１つ上のセル）の数値
Ｆ列＝＋かー
を表示させます。
ただし、Ｅ列の数値が0の場合、となりのＦ列のセルには、Ｆ列の一つ下のセルの値をコピーします。
これを5万行ほど繰り返します。
現在のコードでは処理に時間がかかるので、高速化したいです。
配列を代入する方法を調べてみましたが、条件分岐との組み合わせ方が分からず、つまづいています。よろしくお願いいたします。

現在のコードは以下の通りです。

Subテスト（）
Dim a as long
For a = Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1

        Cells(a, 5) = Cells(a + 1, 4) - Cells(a, 4)
        If Cells(a, 5) > 0 Then
            Cells(a, 6) = "＋"
        End If
        If Cells(a, 5) < 0 Then
            Cells(a, 6) = "ー"
        End If
        If Cells(a, 5) = 0 Then
            Cells(a, 6).Offset(1, 0).Copy Destination:=Cells(a, 6)
        End If
Next
End sub

＜使用 Excel：Office365、使用 OS：Windows10 ＞

 こんばんは　＾＾　
気が付いた点だけですみません。
Ｆ列、って空白でしょうか、それとも何か数値が
存在するのでしょうか。   m(_ _)m
（隠居じーさん） 2019/10/31(木) 21:59

こんなのではだめですか。
あえて、違う列に結果をだしています。

 Sub test()
    Dim r As Range

    Set r = Range("A3", Cells(Rows.Count, 1).End(xlUp))
    r.Columns("G").Formula = "=IF(D4=D3,G4,IF(D4<D3,""ー"",""＋""))"
    r.Value = r.Value

 End Sub

（マナ） 2019/10/31(木) 22:05

こんばんは　＾＾
すみませんでした。勘違いしていました
わたしのコメントは没にしておいてください
m(__)m

（隠居じーさん） 2019/10/31(木) 22:09

 こんばんは！

 早いかどうかはわかりませんが、、こんな感じでどうでしょう？

 Option Explicit
Sub テスト()
Dim a As Long
Dim MyA As Variant
MyA = Range("D3", Range("D" & Rows.Count).End(xlUp).Offset(1)).Value
ReDim Preserve MyA(LBound(MyA, 1) To UBound(MyA, 1), LBound(MyA, 2) To UBound(MyA, 2) + 2)
For a = UBound(MyA, 1) - 1 To LBound(MyA, 1) Step -1
    MyA(a, 2) = MyA(a + 1, 1) - MyA(a, 1)
    If MyA(a, 2) > 0 Then MyA(a, 3) = "＋"
    If MyA(a, 2) < 0 Then MyA(a, 3) = "ー"
    If MyA(a, 2) = 0 Then MyA(a, 3) = MyA(a + 1, 3)
Next
'For a = Cells(Rows.Count, 4).End(xlUp).Row To 3 Step -1
'    Cells(a, 5) = Cells(a + 1, 4) - Cells(a, 4)
'    If Cells(a, 5) > 0 Then
'        Cells(a, 6) = "＋"
'    End If
'    If Cells(a, 5) < 0 Then
'        Cells(a, 6) = "ー"
'    End If
'    If Cells(a, 5) = 0 Then
'        Cells(a, 6).Offset(1, 0).Copy Destination:=Cells(a, 6)
'    End If
'Next
Range("D3", Range("D" & Rows.Count).End(xlUp).Offset(1)).Offset(, 3).Resize(, 3).Value = MyA
Erase MyA
End Sub
（SoulMan） 2019/10/31(木) 23:49

 Elseif を使った方が良いと思うけどね。
 極々無駄が省ける。

 毎回、Cells(a, 5)を見に行かないで、値を変数に入れたら・・・。
（BJ） 2019/11/01(金) 03:05

Sub main()

    Dim dt() As Variant, a As Long
    ReDim dt(1 To Cells(Rows.Count, 1).End(xlUp).Row, 1)
    For a = Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
        k = Cells(a + 1, 4).Value - Cells(a, 4).Value
        dt(a, 0) = k
        dt(a, 1) = Switch(k > 0, "+", k < 0, "-")
    Next
    Range("E1").Resize(Cells(Rows.Count, 1).End(xlUp).Row, 2) = dt
    For a = Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
        If Range("F" & a).Value = "" Then
            Range("F" & a).Value = Range("F" & a).End(xlDown).Value
        End If
    Next
End Sub
（mm） 2019/11/01(金) 12:09

 ほんの枯れ木をひとつ。

 Sub test()
     Dim mat As Variant
     Dim m   As Long
     Dim kk  As Long
     Dim k   As Long

     m = Cells(Rows.count, 1).End(xlUp).Row
     mat = [D3].Resize(m + 1, 3).Value

     For kk = m To 3 Step -1
         k = kk - 2
         mat(k, 2) = mat(k + 1, 1) - mat(k, 1)
         Select Case mat(k, 2)
             Case Is > 0: mat(k, 3) = "＋"
             Case Is < 0: mat(k, 3) = "－"
             Case Is = 0: mat(k, 3) = mat(k + 1, 3)
         End Select
     Next
     [D3].Resize(m + 1, 3).Value = mat
 End Sub
（γ） 2019/11/01(金) 12:54

マナ様
今まで数分かかっていたのが、2秒でできました。ＩＦ関数を使ってここまでシンプルにできるのですね。ありがとうございました！
（むーす） 2019/11/01(金) 17:57

SoulMan様こちらも数秒でできました。配列の作り方、今後の参考にさせていただきます。
ありがとうございました！
（むーす） 2019/11/01(金) 18:10

実は、γさんのとほぼ同じコードを書いていたのですが
SoulManさんのアップを見て、投稿をやめました。

配列を使うことと、Select Caseを使う点で、
γさんのコードも検証して欲しいところです。

マナさんのは別として、ループを使う中では、最速ではないかと、思っています。

（渡辺ひかる） 2019/11/01(金) 18:30

 こんばんは！

 検証はトピ主さんにお任せするとして、、昨夜、今回のコードを書いてるときに

 変数と条件が三つ・・・は考えました。

 多分、、いつもの私だったら、、↓の様に書いていたかも？です。。。

 何となく原文と変わるしなぁ、、とは思いました。。
 何故、最初のコードになったのかは、、その時の気分ですね、、(^^;
 (最近、、わかり難いと言われることが多いのでちょっと気にしていたかも？です。＿|￣|○)

 で、今回の場合は、、入れ物の大きさが事前に分かっているので、、
 Resize　で広げるより、新たに作った方がいいというのを聞いた？見た？ことがある様な？？ない様な？？
 でも、、そうしなかったのは、、そこに値があると書き換えることになのでそれはまずいかな？とは思いました。

 で、分岐は、、まず　0　ではじいて
 大きいか？小さいか？

 と、これも、、この方が、、というのを聞いた？見た？ことがある様な？？ない様な？？あいまいです。。(^^;

 それと、、最初のコードの様に配列？に取り込んでから細工する方法(なんて言うのか忘れました）は、
 速度的には早くないらしいです。。(私は、楽なので多用してます。。あまりこだわってないのですね(^^;）

 で、くれぐれも誤解のない様にお願いしたいのですが、、この速度、、云々については、、先ほども書きましたが
 私は、、全くこだわっていませんので悪しからずご了承願います。。。

 トピ主さんも色々な方法を試されてより良い方法を身に付けられたらいいと思います。。。

 多分、、試されているのでしょうけど、、追っつかないんですよね？(笑)
 どうぞ、、ごゆっくりと、、、

 では、、では、、また、、、

 Option Explicit
Sub テスト()
Dim a As Long
Dim MyA As Variant
Dim MyB As Variant
MyA = Range("D3", Range("D" & Rows.Count).End(xlUp).Offset(1)).Value
ReDim MyB(LBound(MyA, 1) To UBound(MyA, 1), LBound(MyA, 2) To UBound(MyA, 2) + 1)
For a = UBound(MyA, 1) - 1 To LBound(MyA, 1) Step -1
    MyB(a, 1) = MyA(a + 1, 1) - MyA(a, 1)
    If MyB(a, 1) = 0 Then
        MyB(a, 2) = MyB(a + 1, 2)
    Else
        If MyB(a, 1) > 0 Then
            MyB(a, 2) = "＋"
        Else
            MyB(a, 2) = "ー"
        End If
    End If
Next
Range("E3").Resize(UBound(MyB, 1), UBound(MyB, 2)).Value = MyB
Erase MyA, MyB
End Sub
（SoulMan） 2019/11/01(金) 19:51

＞soulmanさん
初心者なもので､まだ追いついてません、すいません笑
まだ､未完成の同じようなコードがあるので､それを作る際に参考にさせていただきます。ゆっくりですが、少しずつ身に着けていけたらと思います｡ありがとうございます｡

（むーす） 2019/11/01(金) 20:44

スマホのストップウォッチでの手動計測で申し訳ありませんが､
マナさん02 0.57
soulmanさん0 0.214
γさん0 0.208

僕としては､どれもほぼ同じくらいかと思ってます (笑)
みなさんが貴重なお時間を割いてコードを考えてくれたことがうれしいです｡
マナさん､隠居じーさんさん､soulmanさん､BJさん､mmさん､γさん､渡辺ひかるさん
ありがとうございました｡

（むーす） 2019/11/01(金) 20:45

コメント返信：

[ 一覧(最新更新順) ]

[[20191031205758]] 『vbaで条件分岐のコードを高速化する方法』（むーす） ページの最後に飛ぶ

[[20191031205758]]　『vbaで条件分岐のコードを高速化する方法』（むーす）　ページの最後に飛ぶ