Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Home : Excel 2016)
効率よく計算式を値に変える方法を教えてください
投稿日時: 21/03/09 14:27:58
投稿者: ip8bk

いつもお世話になっております。
計算式を値に変換するために下記のコードを作成しましたが、動作が2秒以上かかっているので、短縮することを検討しています。
forで回す回数を減らすこと以外で短縮することができますでしょうか?
 
 

Option Explicit
Sub test()

 Dim starttime As Single, stime As Single, endtime As Single, i As Long

    Application.ScreenUpdating = True  '画面更新を再開
    Application.ScreenUpdating = False  '画面更新を停止
    Application.DisplayAlerts = False
    Application.Calculation = xlManual  '計算方法 手動

    starttime = Timer
    stime = Timer '計測開始
    
    For i = 1 To 50
        Range(Cells(1, 1), Cells(10000, 2)) = "=Row()"
        Range(Cells(1, 1), Cells(10000, 2)).Calculate
        Range(Cells(1, 1), Cells(10000, 2)) = Range(Cells(1, 2), Cells(10000, 2)).Value
    Next i
    endtime = endtime + Timer - starttime
    Debug.Print "totalTime:"; endtime; " ("; Now(); ")"
    
    Application.ScreenUpdating = True '画面更新を再開
    Application.Calculation = xlAutomatic '計算方法 自動
    Application.DisplayAlerts = True
    ActiveWindow.Visible = True
    
End Sub

回答
投稿日時: 21/03/09 14:59:33
投稿者: radames1000
メールを送信

一案ですが。
 

    For i = 1 To 50
        
        Dim rng As Variant
        rng = Range(Cells(1, 1), Cells(10000, 2))
        Dim j As Long
        For j = 1 To 10000
            rng(j, 1) = j
            rng(j, 2) = j
        Next
        Range(Cells(1, 1), Cells(10000, 2)) = rng

    Next i

回答
投稿日時: 21/03/09 16:45:24
投稿者: simple

確認ですが、50回繰り返す意味は何でしょうか。
問題をデフォルメしているなら、もともとの問題を提示されたほうが有益だと思います。
そして、どのくらいの時間が適正だと想定しているんでしょうか?

回答
投稿日時: 21/03/09 16:50:52
投稿者: WinArrow
投稿者のウェブサイトに移動

変数:i がループの中で使われていない
なので、なぜ50回ループするのわかりませんが、
1回の値変換でしたら、次のようなコードがわかりやすいし、早いと思います。
 

    With ActiveSheet
        With .Range("A1").Resize(2, 10000)
            .Formula = "=ROW()"
            .Value = .Value
        End With
    End With

 
 

投稿日時: 21/03/10 07:55:04
投稿者: ip8bk

皆様
ご回答ありがとうございます。
動作確認いたしましたので、取り急ぎ結果をご報告いたします。
 
radames1000さんのコードが一番早いですが、実際にコードに適応できるか難しいところです。
WinArrowさんのコードはあまり相違ありませんでした;
 
test1_totalTime: 2.441406
test2_totalTime: 1.337891
test3_totalTime: 2.435547
 

Option Explicit

Sub test()

 Dim starttime As Single, stime As Single, endtime As Single, i As Long

    Application.ScreenUpdating = True  '画面更新を再開
    Application.ScreenUpdating = False  '画面更新を停止
    Application.DisplayAlerts = False
    Application.Calculation = xlManual  '計算方法 手動

    starttime = Timer
    stime = Timer '計測開始
    Dim rng As Variant
    rng = Range("A1").Resize(10000, 2).Value
    
    For i = 1 To 50
        With ActiveSheet.Range(Cells(1, 1), Cells(10000, 2))
            .Formula = "=Row()"
            .Calculate
            .Value = .Value
        End With
    Next i
    
    endtime = endtime + Timer - starttime
    Debug.Print "test1_totalTime:"; endtime; " ("; Now(); ")"
    
    Application.ScreenUpdating = True '画面更新を再開
    Application.Calculation = xlAutomatic '計算方法 自動
    Application.DisplayAlerts = True
    ActiveWindow.Visible = True
    
End Sub

Sub test2()

 Dim starttime As Single, stime As Single, endtime As Single, i As Long
 
    Application.ScreenUpdating = True  '画面更新を再開
    Application.ScreenUpdating = False  '画面更新を停止
    Application.DisplayAlerts = False
    Application.Calculation = xlManual  '計算方法 手動

    starttime = Timer
    stime = Timer '計測開始
    
    For i = 1 To 50
        
        Dim rng As Variant
        rng = Range(Cells(1, 1), Cells(10000, 2))
        Dim j As Long
        For j = 1 To 10000
            rng(j, 1) = j
            rng(j, 2) = j
        Next
        Range(Cells(1, 1), Cells(10000, 2)) = rng

    Next i
    
    endtime = endtime + Timer - starttime
    Debug.Print "test2_totalTime:"; endtime; " ("; Now(); ")"
    
    Application.ScreenUpdating = True '画面更新を再開
    Application.Calculation = xlAutomatic '計算方法 自動
    Application.DisplayAlerts = True
    ActiveWindow.Visible = True
    
End Sub

Sub test3()

 Dim starttime As Single, stime As Single, endtime As Single, i As Long

    Application.ScreenUpdating = True  '画面更新を再開
    Application.ScreenUpdating = False  '画面更新を停止
    Application.DisplayAlerts = False
    Application.Calculation = xlManual  '計算方法 手動

    starttime = Timer
    stime = Timer '計測開始
    Dim rng As Variant
    rng = Range("A1").Resize(10000, 2).Value
    
    For i = 1 To 50
        With ActiveSheet
            With .Cells(1, 1).Resize(10000, 2)
                .Formula = "=Row()"
                .Calculate
                .Value = .Value
            End With
        End With
    Next i
    
    endtime = endtime + Timer - starttime
    Debug.Print "test3_totalTime:"; endtime; " ("; Now(); ")"
    
    Application.ScreenUpdating = True '画面更新を再開
    Application.Calculation = xlAutomatic '計算方法 自動
    Application.DisplayAlerts = True
    ActiveWindow.Visible = True
    
End Sub

回答
投稿日時: 21/03/10 08:30:16
投稿者: radames1000
メールを送信

引用:
実際にコードに適応できるか難しいところです。

 
提示された条件で回答したものですので、
実際のコードを示していただかなければこれ以上は難しいですよ。

回答
投稿日時: 21/03/10 09:52:03
投稿者: simple

計測ご苦労様でした。
 
radames1000さんの回答は、
「書き込みをする際には、配列にして一括書き込みするのが有効である」というテクニックは、
速度アップの議論ではよく使用される基本的かつ効果的なテクニックです。
こうした質問掲示板の速度アップの議論では、配列書き込みで効果が上がることは
よく経験することです。妥当なご指摘と思いました。
同じ結果が得られるわけですから、この例に適切な回答のひとつであると考えます。
 
ところで、
>50回繰り返す意味は何でしょうか。
と質問させていただきましたが、お答えいただけないのは残念です。
 
式を値に変換するのに、どうして50回同じことを実行するのか、説明が必要でしょう。
意味もなく50回も繰り返して、"2秒以上もかかる"とおっしゃることのほうが余程不自然な話で、
一回だけの処理にするのが一番の効率化だと思います。
セルへの書き込みは比較的時間を要するもので、2万セルの設定に0.04秒程度かかるのは
致し方ないようにも思えます。
 
その他の気づき。
(1).Calculateは不要ではないでしょうか。それを無くしても速度はさほど向上しないと思いますが、
   なくても同じ結果のはずです。
   =ROW()と入力すれば、式入力に伴ってそれに対応する値はセットされるわけで、
   わざわざCalculate命令を実行する必要はないものと考えます。
   手動計算にしているのは、もちろん再計算を抑止するものですが、当該変更されたセルの
   計算がされないことは意味しないと思います。
 
(2)以下は、細かい話で恐縮ですが、気になりました。
    ・starttime = Timer と stime = Timer '計測開始 と二つ変数を持つ意味はあるのですか?
      部分毎の経過時間を計る目的かもしれませんが、この例では不要でしょう。
    ・endtime = endtime + Timer - starttime は
      endtime = Timer - starttime とすべきじゃないですか?
      また、変数名がconfusingです。経過時間とendtimeは意味が違います。
    ・Application.ScreenUpdating = True '画面更新を再開 を入れてから
      その後、抑止していますが、何か意味でもあるのですか?単なるミスですか?

回答
投稿日時: 21/03/10 10:16:19
投稿者: Suzu

引用:
動作確認いたしましたので、取り急ぎ結果をご報告いたします。
  
radames1000さんのコードが一番早いですが、実際にコードに適応できるか難しいところです。
WinArrowさんのコードはあまり相違ありませんでした;

 
目的は何ですか?
A1:B10000 に、行数と同じ値を入れる を 50回繰り返す と読めます。
(50回は、速度テストの為に繰り返す と読めますが、処理内容は)
 
テストなのであれば、
  Test3 のみ、
   With ActiveSheet With .Cells(1, 1).Resize(10000, 2) と 2段階を踏むのはどうでしてですか?
   処理対象が変わらないのであれば、ループの外でWithすれば良いですし、テストなのであれば
   Test1〜Test3 処理対象を明確にしたり、しなかったり 曖昧で、厳密な比較になっていません。
 
 
高速化を行いたいなら
・テスト2以外で rng に、セルの値を渡すのは何故ですか?
    → 必要ない様に見えます。
・コピーし、値の貼り付け をテストしてみてください。
 
 
関数によっても、どうしたら高速に処理できるのか 変わります。
単に =Row() で代用できるとは限りません。
 
中途半端な情報・条件を提示しても、あなたにとっては、中途半端な回答にしかならないと思いますよ。

投稿日時: 21/03/10 10:44:47
投稿者: ip8bk

皆様ご回答ありがとうございます。
 
まずforを50回繰り返す理由についてご説明いたします。
 
50回は値に変換する必要がある行が5行あり、これを10ファイル分繰り返すので、50回繰り返しています。
 
コードに関していろんなご指摘ありがとうございます。
修正しましたので再送いたします。
 
calculateに関しては完全に意味を理解できていなかったのが原因です。
 
test1_totalTime: 2.30
test2_totalTime: 1.30
test3_totalTime: 2.29
 

Option Explicit

Sub test()

 Dim starttime As Single, endtime As Single, i As Long

    Application.ScreenUpdating = False  '画面更新を停止
    Application.DisplayAlerts = False
    Application.Calculation = xlManual  '計算方法 手動

    starttime = Timer
    
    With ActiveSheet.Range(Cells(1, 1), Cells(10000, 2))
        For i = 1 To 50
            .Formula = "=Row()"
            .Value = .Value
        Next i
    End With
    
    endtime = Timer - starttime
    Debug.Print "test1_totalTime:"; endtime; " ("; Now(); ")"
    
    Application.ScreenUpdating = True '画面更新を再開
    Application.Calculation = xlAutomatic '計算方法 自動
    Application.DisplayAlerts = True
    ActiveWindow.Visible = True
    
End Sub

Sub test2()

 Dim starttime As Single, endtime As Single, i As Long
 
    Application.ScreenUpdating = False  '画面更新を停止
    Application.DisplayAlerts = False
    Application.Calculation = xlManual  '計算方法 手動

    starttime = Timer
    
    For i = 1 To 50
        
        Dim rng As Variant
        rng = Range(Cells(1, 1), Cells(10000, 2))
        Dim j As Long
        For j = 1 To 10000
            rng(j, 1) = j
            rng(j, 2) = j
        Next
        Range(Cells(1, 1), Cells(10000, 2)) = rng

    Next i
    
    endtime = Timer - starttime
    Debug.Print "test2_totalTime:"; endtime; " ("; Now(); ")"
    
    Application.ScreenUpdating = True '画面更新を再開
    Application.Calculation = xlAutomatic '計算方法 自動
    Application.DisplayAlerts = True
    ActiveWindow.Visible = True
    
End Sub

Sub test3()

 Dim starttime As Single, endtime As Single, i As Long

    Application.ScreenUpdating = False  '画面更新を停止
    Application.DisplayAlerts = False
    Application.Calculation = xlManual  '計算方法 手動

    starttime = Timer

    With ActiveSheet.Cells(1, 1).Resize(10000, 2)
        For i = 1 To 50
                .Formula = "=Row()"
                .Value = .Value
        Next i
    End With
    
    endtime = Timer - starttime
    Debug.Print "test3_totalTime:"; endtime; " ("; Now(); ")"
    
    Application.ScreenUpdating = True '画面更新を再開
    Application.Calculation = xlAutomatic '計算方法 自動
    Application.DisplayAlerts = True
    ActiveWindow.Visible = True
    
End Sub

 
 

回答
投稿日時: 21/03/10 10:56:42
投稿者: Suzu

引用:
50回は値に変換する必要がある行が5行あり、これを10ファイル分繰り返すので、50回繰り返しています。
 
コードに関していろんなご指摘ありがとうございます。
修正しましたので再送いたします。

 
テストコードを再送いただいても、実際に行う関数等が判らないと、これ以上コメントのしようがありません。
 
 
ファイルが閉じている状態から、ファイル開いて処理を行い保存し閉じる を10回繰り返すなら
関数の計算式から値に変える処理より、ファイルの開閉・保存の方がよっぽど時間を要すると思いますよ。

投稿日時: 21/03/10 11:00:37
投稿者: ip8bk

ご回答ありがとうございます。
 
 

引用:
ファイルが閉じている状態から、ファイル開いて処理を行い保存し閉じる を10回繰り返すなら
関数の計算式から値に変える処理より、ファイルの開閉・保存の方がよっぽど時間を要すると思いますよ。

 
ご指定の通り、ファイル開閉処理は時間がかかりますが、時間のカウントを分けていますので、今回は該当しません。説明不足で申し訳ございません。

回答
投稿日時: 21/03/10 11:29:11
投稿者: hatena
投稿者のウェブサイトに移動

ip8bkさん提示のテスト用コードですが、
test1 と test3 がまったく同じコードになってますね。
 
test1を質問のコードに修正して実行してみたところ下記のような結果になりました。
 
test1_totalTime: 4.394531
test2_totalTime: 1.386719
test3_totalTime: 2.304688
 
まとめて式を値に変換するtest3もかなり早くなってますが、配列で一気に格納するのはやはり早いですね。
 
ただ、test3は関数Row()を呼び出してますが、test2 は単に変数を代入しているだけなので、正確な比較にはならないです。
 
実際の関数によっては逆転する可能性もありそうです。

回答
投稿日時: 21/03/10 11:39:51
投稿者: hatena
投稿者のウェブサイトに移動

ip8bk さんの引用:
まずforを50回繰り返す理由についてご説明いたします。
50回は値に変換する必要がある行が5行あり、これを10ファイル分繰り返すので、50回繰り返しています。

 
テストコードは10000行×50回ですね。それで数秒。
5行ならミリ秒以下になるのでは。
 
この部分の高速化に時間を割くより、
呼び出している関数の高速化を考えたほうが有意義かと。
 
そもそもなぜ値に変換する必要があるのか、その理由もお聞きしたいです。[/b]

投稿日時: 21/03/10 11:52:46
投稿者: ip8bk

ご回答ありがとうございます。
 
すみません間違えました。5行ではなく5列の間違いです。
行は固定ではありませんが、平均で10000行あります。
 
  

引用:
そもそもなぜ値に変換する必要があるのか、その理由もお聞きしたいです。

 
初めにご説明するべきでしたが、ファイルの容量を少しでも減らすことが目的です。

回答
投稿日時: 21/03/10 13:30:01
投稿者: Suzu

ip8bk さんの引用:
ご指定の通り、ファイル開閉処理は時間がかかりますが、時間のカウントを分けていますので、今回は該当しません。説明不足で申し訳ございません。

 
今回のご質問が、技術的な興味から来る ご質問なのであれば良いのですが、
もし、処理全体の処理速度向上の一環からのご質問であるならば、
 
まずは、多くの時間を要している処理についての速度向上について検討をされた方が効率的であると思いますので、お話をさせて頂きました。
 
処理時間の短縮については、先にも述べていますが セルをコピーし値の貼り付け をテストしてみてください。
 
処理内容を揃えるのであれば
 
Sub test4()

 Dim starttime As Single, endtime As Single, i As Long

    Application.ScreenUpdating = False  '画面更新を停止
    Application.DisplayAlerts = False
    Application.Calculation = xlManual  '計算方法 手動

    starttime = Timer

    With ActiveSheet.Cells(1, 1).Resize(10000, 2)
        For i = 1 To 50
            .Formula = "=Row()"
            .Copy
            .PasteSpecial Paste:=xlPasteValues
        Next i
    End With

    endtime = Timer - starttime
    Debug.Print "test4_totalTime:"; endtime; " ("; Now(); ")"

    Application.ScreenUpdating = True '画面更新を再開
    Application.Calculation = xlAutomatic '計算方法 自動
    Application.DisplayAlerts = True
    ActiveWindow.Visible = True

End Sub

この様になるかと。

投稿日時: 21/03/10 13:49:26
投稿者: ip8bk

ご回答ありがとうございます。
test4を追加し、test1を修正して再測定致しましたのでご報告いたします。
 
今回質問させていただきましたのは、速度向上を目的としております。
コード全体ではなく、testコードで時間かかかっていることを確認しております。他のコードは該当しませんのでご了承ください。(m_ _m)
 
 
test1_totalTime: 2.43
test2_totalTime: 1.30
test3_totalTime: 2.08
test4_totalTime: 2.97
 
 

Option Explicit

Sub test()

 Dim starttime As Single, endtime As Single, i As Long

    Application.ScreenUpdating = False  '画面更新を停止
    Application.DisplayAlerts = False
    Application.Calculation = xlManual  '計算方法 手動

    starttime = Timer
    
        For i = 1 To 50
            ActiveSheet.Range(Cells(1, 1), Cells(10000, 2)).Formula = "=Row()"
            ActiveSheet.Range(Cells(1, 1), Cells(10000, 2)).Value = ActiveSheet.Range(Cells(1, 1), Cells(10000, 2)).Value
        Next i
    
    endtime = Timer - starttime
    Debug.Print "test1_totalTime:"; endtime; " ("; Now(); ")"
    
    Application.ScreenUpdating = True '画面更新を再開
    Application.Calculation = xlAutomatic '計算方法 自動
    Application.DisplayAlerts = True
    ActiveWindow.Visible = True
    
End Sub

Sub test2()

 Dim starttime As Single, endtime As Single, i As Long
 
    Application.ScreenUpdating = False  '画面更新を停止
    Application.DisplayAlerts = False
    Application.Calculation = xlManual  '計算方法 手動

    starttime = Timer
    
    For i = 1 To 50
        
        Dim rng As Variant
        rng = Range(Cells(1, 1), Cells(10000, 2))
        Dim j As Long
        For j = 1 To 10000
            rng(j, 1) = j
            rng(j, 2) = j
        Next
        Range(Cells(1, 1), Cells(10000, 2)) = rng

    Next i
    
    endtime = Timer - starttime
    Debug.Print "test2_totalTime:"; endtime; " ("; Now(); ")"
    
    Application.ScreenUpdating = True '画面更新を再開
    Application.Calculation = xlAutomatic '計算方法 自動
    Application.DisplayAlerts = True
    ActiveWindow.Visible = True
    
End Sub

Sub test3()

 Dim starttime As Single, endtime As Single, i As Long

    Application.ScreenUpdating = False  '画面更新を停止
    Application.DisplayAlerts = False
    Application.Calculation = xlManual  '計算方法 手動

    starttime = Timer

    With ActiveSheet.Cells(1, 1).Resize(10000, 2)
        For i = 1 To 50
                .Formula = "=Row()"
                .Value = .Value
        Next i
    End With
    
    endtime = Timer - starttime
    Debug.Print "test3_totalTime:"; endtime; " ("; Now(); ")"
    
    Application.ScreenUpdating = True '画面更新を再開
    Application.Calculation = xlAutomatic '計算方法 自動
    Application.DisplayAlerts = True
    ActiveWindow.Visible = True
    
End Sub

Sub test4()

 Dim starttime As Single, endtime As Single, i As Long

    Application.ScreenUpdating = False  '画面更新を停止
    Application.DisplayAlerts = False
    Application.Calculation = xlManual  '計算方法 手動

    starttime = Timer

    With ActiveSheet.Cells(1, 1).Resize(10000, 2)
        For i = 1 To 50
            .Formula = "=Row()"
            .Copy
            .PasteSpecial Paste:=xlPasteValues
        Next i
    End With

    endtime = Timer - starttime
    Debug.Print "test4_totalTime:"; endtime; " ("; Now(); ")"

    Application.ScreenUpdating = True '画面更新を再開
    Application.Calculation = xlAutomatic '計算方法 自動
    Application.DisplayAlerts = True
    ActiveWindow.Visible = True

End Sub

回答
投稿日時: 21/03/10 14:07:56
投稿者: hatena
投稿者のウェブサイトに移動

前回の私の回答の計測時間は無視してください。
もう一度何回か計測したら、Test1 と Test3 は差はほぼありませんでした。
 
 
ただし、Test2は関数を使用していないので、同一条件での比較にはなりません。
そこで、例えば SUM関数で比較してみました。
 

    For i = 1 To 50
        Range(Cells(1, 1), Cells(10000, 2)) = "=SUM($F$1:$F$5)"
        Range(Cells(1, 1), Cells(10000, 2)) = Range(Cells(1, 2), Cells(10000, 2)).Value
    Next i

 
        For j = 1 To 10000
            rng(j, 1) = WorksheetFunction.Sum(Range("$F$1:$F$5"))
            rng(j, 2) = j
        Next

 
これなら同一条件だといえるでしょう。
結果は、前者の方が倍ぐらい高速でした。
 
これも関数によっては結果が変わる可能性はあるでしょう。
 
現状の式を提示してもらったら、もっといい方法を提示できるかもしれません。

投稿日時: 21/03/10 14:47:16
投稿者: ip8bk

ご回答ありがとうございます。
取り急ぎ現在のコードを送付いたします。
後ほどご説明させていただきますので、よろしくお願いいたします。
 
 
 

Option Explicit
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

Sub chart_data_collecting()

    Dim paste_col As Integer, paste_col2 As Integer, paste_col3 As Integer, i As Integer, ii As Integer
    Dim hh As Long, ee As Long, cc As Long, atl As Long, rr As Long, xr As Long, krb As Long, elg As Long, elg_ran As Long, nos3 As Long, elg_max As Double, elg_max_cou As Long
    Dim dd As Double
    Dim cr As String, ca As String, kr1 As String, kur As String, kr2 As String, vlookuprange2 As String
    Dim starttime As Single, endtime As Single, time4 As Single, time5 As Single, time6 As Single, time7 As Single, time8 As Single, stime As Single, kar As Single
    
starttime = Timer
stime = Timer
    
    paste_col = 16
    paste_col2 = paste_col + c * 2
    paste_col3 = paste_col + c * 4
    
    Range(Columns(paste_col + 2), Columns(paste_col3 + c * 2 + 1)).NumberFormatLocal = "0"
    For i = 1 To c
        atl = Columns(4).Find(What:="SSS", After:=Cells(atl + 1, 4), LookIn:=xlValues, LookAt:=xlWhole).Row
        ca = Range(Cells(atl, 4).Offset(2, 0), Cells(atl, 4).Offset(2, 1).End(xlDown)).Address
        cr = Cells(atl, 4).Offset(2, 1).End(xlDown).Row
        Range(Cells(2, paste_col + i * 2), Cells(2, paste_col + i * 2).Offset(cr - atl - 2, 1)) = Range(ca).Value
        Cells(1, paste_col + i * 2) = "N" & i * 2 - 1
        Cells(1, paste_col + i * 2 + 1) = "N" & i * 2
    Next i
    With Range(Cells(1, 18), Cells(1, c * 2 + 17))
        Range(Cells(1, c * 2 + 18), Cells(1, c * 4 + 17)) = .Value
        Range(Cells(1, c * 4 + 18), Cells(1, c * 6 + 17)) = .Value
    End With
    kar = UserForm1.TextBox1.Value

time4 = Format(time4 + Timer - stime, "0.0")
stime = Timer '計測開始

    For i = 1 To c
        rr = Cells(1, paste_col + i * 2).End(xlDown).Row
        kr1 = Range(Cells(2, paste_col2 + i * 2), Cells(rr, paste_col2 + i * 2)).Address
        Range(kr1) = "=IF(ROW()=2,IF(r[0]c[" & -c * 2 + 1 & "]>" & kar & ",r[0]c[" & -c * 2 & "],""""),IF(and(r[-1]c[0]<>"""",r[0]c[" & -c * 2 + 1 & "]<>""""),r[0]c[" & -c * 2 & "],if(r[0]c[" & -c * 2 + 1 & "]>" & kar & ",r[0]c[" & -c * 2 & "],"""")))"
        kr2 = Range(Cells(2, paste_col2 + i * 2 + 1), Cells(rr, paste_col2 + i * 2 + 1)).Address
        Range(kr2) = "=IF(r[0]c[-1]<>"""",round(r[0]c[" & -c * 2 & "],6),"""")"
        With Range(kr1, kr2)
'            .Calculate
            .Value = .Value
        End With
        If Cells(2, paste_col2 + i * 2) = "" Then
            krb = WorksheetFunction.CountBlank(Range(kr1))
            Range(Cells(2, paste_col2 + i * 2), Cells(1 + krb, paste_col2 + i * 2 + 1)).Delete shift:=xlUp
        End If
    Next i
    
time5 = Format(time5 + Timer - stime, "0.0")
stime = Timer
    
    hh = 16 + c - 2
    ee = 18 + c * 2
    For i = 1 To c
        dd = Application.WorksheetFunction.Round(Cells(hh + i, 15), 6)
        cc = Columns(ee - 1 + i * 2).Find(What:=dd, LookIn:=xlFormulas2, LookAt:=xlPart, searchorder:=xlByRows).Row
        Cells(hh + i, 16) = Cells(cc, ee - 2 + i * 2).Value
    Next i

time6 = Format(time6 + Timer - stime, "0.0")
stime = Timer
    
    For i = 1 To c
        xr = Cells(1, paste_col2 + i * 2).End(xlDown).Row
        elg = Cells(14 + c + i, 16)
        If elg < 1000 Then
            elg_ran = Application.WorksheetFunction.RoundDown(4 + elg / 100, 0)
        Else
            elg_ran = 14
        End If
        Range(Cells(2, paste_col3 + i * 2), Cells(xr, paste_col3 + i * 2)) = "= rc[" & -c * 2 & "]-r2c[" & -c * 2 & "]"
        Range(Cells(2, paste_col + i * 2 + 1 + c * 4), Cells(xr, paste_col + i * 2 + 1 + c * 4)) = "= round(rc[" & -c * 2 & "],6)-round(r2c" & paste_col2 + 1 + i * 2 & ",6)"
        vlookuprange2 = Range(Cells(2, paste_col3 + i * 2), Cells(xr, paste_col + i * 2 + 1 + c * 4)).Address(, , xlR1C1)
        Range(Cells(1 + i, 20 + c * 6), Cells(1 + i, 19 + c * 6 + elg_ran)) = "=vlookup(r[" & -i & "]c," & vlookuprange2 & ",2,1)"
    Next i
    With Range(Cells(2, paste_col3 + c * 2), Cells(xr, paste_col3 + c * 2 + 1))
        .Calculate
        .Value = .Value
    End With
    
time7 = Format(time7 + Timer - stime, "0.0")
stime = Timer
    
    elg_max = WorksheetFunction.Max(Range(Cells(15 + c, 16), Cells(14 + c * 2, 16)))
    If elg_max < 1000 Then
        elg_max_cou = Application.WorksheetFunction.RoundDown(4 + elg_max / 100, 0)
    Else
        elg_max_cou = 14
    End If
    Range(Cells(2 + c, 20 + c * 6), Cells(2 + c, 19 + c * 6 + elg_max_cou)) = "= average(r[-1]c:r[" & -c & "]c)"
    
time8 = Format(time8 + Timer - stime, "0.0")
stime = Timer
endtime = Format(endtime + Timer - starttime, "0.0")
    
    Debug.Print "data_collecting-4:" & time4; " ("; Now(); ")"
    Debug.Print "data_collecting-5:" & time5; " ("; Now(); ")"
    Debug.Print "data_collecting-6:" & time6; " ("; Now(); ")"
    Debug.Print "data_collecting-7:" & time7; " ("; Now(); ")"
    Debug.Print "data_collecting-8:" & time8; " ("; Now(); ")"
    Debug.Print "totaltime:" & endtime; " ("; Now(); ")"

End Sub

回答
投稿日時: 21/03/10 22:49:42
投稿者: WinArrow
投稿者のウェブサイトに移動

ファイル(ブック)が複数ある。
という前提で考えると
>For i= 1 To 50
ではなく、キチンをブックを切りかえるコードにしましょう。
また、ブック、シートで修飾していないので、ブックをアクティブ〜シートをアクティブにする
コードが必要です。
 
それから
変数:C の定義されていませんよ。
 
処理時間を気にするわりには、雑なコードという感じがします。

投稿日時: 21/03/11 12:59:09
投稿者: ip8bk

ご回答ありがとうございます。
ご指摘の通り、他のプロシージャーにある変数cの情報を記載するのを忘れていましたので、取り急ぎ追記させていただきます。
 

Public c As Long
c = .CountIf(Rows(2), "BB")

回答
投稿日時: 21/03/11 15:19:15
投稿者: simple

別件で恐縮です。
 
上の変数cの宣言漏れも、UserFormの話にも共通しますが、
Option Explicit
をモジュールの一行目に挿入するようにして下さい。
そうすれば、今回のような未宣言の変数には警告が出て、
しかも場所を特定してくれますから、原因が直ぐに判明します。
http://officetanaka.net/excel/vba/beginner/06.htm
 
ツール − オプション − 編集 で
「変数の宣言を強制する」にチェックを入れてください。
モジュールを作成した時点で、Option Explicitが自動的に挿入されるので、
手間が省けます。

一度だけチェックを入れておきさえすれば、以後、気にする必要はありません。
 
# 私の回答用テンプレートに載せてあり、
# これを使ってコメントすることにしています。
# 割と基本的な話ですが、デフォルトがチェックオフなので、
# 気づかないで苦労する初心の方が多いです。

回答
投稿日時: 21/03/11 18:25:33
投稿者: WinArrow
投稿者のウェブサイトに移動

ip8bk さんの引用:
ご回答ありがとうございます。
ご指摘の通り、他のプロシージャーにある変数cの情報を記載するのを忘れていましたので、取り急ぎ追記させていただきます。
 
Public c As Long
c = .CountIf(Rows(2), "BB")


 
どこに挿入したのかわかりませんが、
WorksheetFunctionオブジェクトは、どこにあるのかな?
確認してレスしていますか?

投稿日時: 21/03/23 15:18:12
投稿者: ip8bk

返信遅くなりすみません。
変数Cは宣言を忘れていたのではなく、グローバル変数で他のプロシージャーに存在しています。
 

引用:
処理時間を気にするわりには、雑なコードという感じがします。

どの辺が雑でしょうか?

回答
投稿日時: 21/03/23 17:33:15
投稿者: WinArrow
投稿者のウェブサイトに移動

ip8bk さんの引用:
返信遅くなりすみません。
変数Cは宣言を忘れていたのではなく、グローバル変数で他のプロシージャーに存在しています。

グローバル変数は、プロシジャ内には、定義できないと思いますが・・・・
他のモジュールの間違いカナ?
 
 
ip8bk さんの引用:

引用:
処理時間を気にするわりには、雑なコードという感じがします。

どの辺が雑でしょうか?

 
一番の違和感h、
シートで修飾していないことです。
>ブックが複数ある
ならば、切替のコードが見当たらないし・・・

投稿日時: 21/03/23 17:55:56
投稿者: ip8bk

ここではブックは複数存在しません。
なのでブックでは修飾する必要がありません。
そのほかはどうでしょうか?

回答
投稿日時: 21/03/23 18:17:42
投稿者: WinArrow
投稿者のウェブサイトに移動

最初に掲示したコードと
まったく異なるコードに入れ替わっていますよね?
 
質問のタイトルは、「効率定な数式の値変換」ですよね?
値変換のコードは、1行しか見当たりません。
それ以外のところの処理時間を計測していますよね?
 
質問の内容とやっていることの関連がよくわかりません。
また、話の流れがよくわからないのです。
 
話が変わったのでしたら、別スレにした方がよいのでは?

回答
投稿日時: 21/03/24 00:02:36
投稿者: WinArrow
投稿者のウェブサイトに移動

最後に掲示のコードの中に
> Range(Columns(paste_col + 2), Columns(paste_col3 + c * 2 + 1)).NumberFormatLocal = "0"
が書かれているが、
このコードは動作しますか?

投稿日時: 21/03/24 07:24:53
投稿者: ip8bk

ご回答ありがとうございます。
 

引用:
最後に掲示のコードの中に
> Range(Columns(paste_col + 2), Columns(paste_col3 + c * 2 + 1)).NumberFormatLocal = "0"
が書かれているが、
このコードは動作しますか?

 
21/03/10 14:47:16のコードにはエラーは含まれませんので、もちろんご質問の箇所も問題なく動作します。
何か気になる部分ございますでしょうか?
 
特に下記のコードの動作が遅く、その中でも .Value = .Valueの一行が遅いことがわかっているので(コメントアウトにすると動作時間が早くなるため)、今回の質問をさせていただいております。
 
    For i = 1 To c
        rr = Cells(1, paste_col + i * 2).End(xlDown).Row
        kr1 = Range(Cells(2, paste_col2 + i * 2), Cells(rr, paste_col2 + i * 2)).Address
        Range(kr1) = "=IF(ROW()=2,IF(r[0]c[" & -c * 2 + 1 & "]>" & kar & ",r[0]c[" & -c * 2 & "],""""),IF(and(r[-1]c[0]<>"""",r[0]c[" & -c * 2 + 1 & "]<>""""),r[0]c[" & -c * 2 & "],if(r[0]c[" & -c * 2 + 1 & "]>" & kar & ",r[0]c[" & -c * 2 & "],"""")))"
        kr2 = Range(Cells(2, paste_col2 + i * 2 + 1), Cells(rr, paste_col2 + i * 2 + 1)).Address
        Range(kr2) = "=IF(r[0]c[-1]<>"""",round(r[0]c[" & -c * 2 & "],6),"""")"
        With Range(kr1, kr2)
'            .Calculate
            .Value = .Value
        End With
        If Cells(2, paste_col2 + i * 2) = "" Then
            krb = WorksheetFunction.CountBlank(Range(kr1))
            Range(Cells(2, paste_col2 + i * 2), Cells(1 + krb, paste_col2 + i * 2 + 1)).Delete shift:=xlUp
        End If
    Next i

 
引用:
話が変わったのでしたら、別スレにした方がよいのでは?

 
最初から話は何も変わっていません。もう一度ご確認いただければわかると思います。

回答
投稿日時: 21/03/24 08:26:44
投稿者: WinArrow
投稿者のウェブサイトに移動

WinArrow さんの引用:
最後に掲示のコードの中に
> Range(Columns(paste_col + 2), Columns(paste_col3 + c * 2 + 1)).NumberFormatLocal = "0"
が書かれているが、
このコードは動作しますか?

 
この件は、私の勘違いでした。
 
引用:
特に下記のコードの動作が遅く、その中でも .Value = .Valueの一行が遅いことがわかっているので(コメントアウトにすると動作時間が早くなるため)、今回の質問をさせていただいております。

 
これを最初から説明された方がよかったと思います。
ただ
.Value = .Value
ではなく
.Calculate
再計算に時間が掛かっているように思います。
(最後では、コメントアウトしていますが、)
 
 

投稿日時: 21/03/24 08:48:01
投稿者: ip8bk

  

引用:
これを最初から説明された方がよかったと思います。
ただ
.Value = .Value
ではなく
.Calculate
再計算に時間が掛かっているように思います。
 (最後では、コメントアウトしていますが、)

 
説明不足があり申し訳ありません。
 
今回のスレッドで以前下記のご回答をいただきました。
下記の通りなくても同様の結果になったため、以後コメントアウトのままにしています。
このことから、calculateは該当しません。
 
 
引用:
(1).Calculateは不要ではないでしょうか。それを無くしても速度はさほど向上しないと思いますが、
   なくても同じ結果のはずです。

 

回答
投稿日時: 21/03/25 18:16:58
投稿者: mattuwan44

Option Explicit

Sub test1()
    Dim i As Long
    Dim t
    
    t = Timer
    
    For i = 1 To 50
        With Range("A1").Resize(10000, 2)
            .Formula = "=row()"
            .Value = .Value
        End With
    Next
    
    Debug.Print Timer - t
End Sub

Sub test2()
    Dim i As Long
    Dim t
    
    t = Timer
    
    For i = 1 To 50
        With Range("A1").Resize(10000, 2)
            .ClearContents
            .Formula = "=row()"
            .Value = .Value
        End With
    Next
    
    Debug.Print Timer - t
End Sub

Sub test5()
    Dim i As Long
    Dim t
    
    t = Timer
    
    For i = 1 To 50
        With Range("A1").Resize(10000, 2)
            .ClearContents
            .Formula = "=row()"
            .Copy
            .PasteSpecial xlPasteValues
        End With
    Next
    
    Debug.Print Timer - t
End Sub


 
 
.Value = .Value
に変わる方法として、
普通にコピーして値貼り付けの方法が提案されてますが、試してないのかな?
対象セルが多くなるとコピペの方が速くなるようです。
 
50回で2〜3秒ならまぁまぁだと思います。
 
数式の内容が把握できてませんが、
高速化を目論むなら、
他で頑張るか、
ハードの性能を上げるか、
くらいではないでしょうか?
あ、あと上書きより一旦クリアした方がセルへの書き込みは速くなるようです。

回答
投稿日時: 21/03/26 09:33:29
投稿者: Suzu

計算しようとする関数を提示頂いたのですが、変数が多く追いきれていない状況ですが、
 
気づいた点を記載させて頂きます。
 
1)1セル毎に、 処理を行うのではなく、セルを纏めて処理する。
   セルの数式代入→値の代入
  
2)セルの削除は時間の掛かる処理です。これを一気にできないかを検討する。
 
3)現状のフォーマットは、複数行にて データ1件分 のデータだと拝見しました。
   VBAで1件毎に数式を代入ではなく、セルのコピペで対応できないかを検討する
 
 

    For i = 1 To c
        atl = Columns(4).Find(What:="SSS", After:=Cells(atl + 1, 4), LookIn:=xlValues, LookAt:=xlWhole).Row
        ca = Range(Cells(atl, 4).Offset(2, 0), Cells(atl, 4).Offset(2, 1).End(xlDown)).Address
        cr = Cells(atl, 4).Offset(2, 1).End(xlDown).Row
        Range(Cells(2, paste_col + i * 2), Cells(2, paste_col + i * 2).Offset(cr - atl - 2, 1)) = Range(ca).Value

 
4)"SSS" を対象契機としてセル位置を特定していますが、フィルターを使って特定できないか。
 
5)最終の、Range(ca).Value にしても、ca を変数に取り、その値を得ていますが
  初めから Valueプロパティーを変数に持つ事で、Rangeへのアクセスを減らす事ができます。
 
6)WorksheetFunction をループ内で多く発生しています。
 作業列を用意する事で、オートフィルにて対応できる様にならないか検討
 
7)既存のフォーマットを、1件1行の表形式に直す事で処理が軽くなるのであればそれを検討する

投稿日時: 21/04/02 07:24:58
投稿者: ip8bk

mattuwan44様
 
ご返信が遅くなり申し訳ありません。
下記のtest5を試してみましたが、下記の結果になりました。
テストコードでは効果が見られませんでしたが、元のコードでも試してみます。
ご提案いただきありがとうございました。
 
結果:
test1_totalTime: 2.199219 (2021/04/02 7:05:15 )
test2_totalTime: 1.345703 (2021/04/02 7:05:18 )
test3_totalTime: 2.011719 (2021/04/02 7:17:12 )
test4_totalTime: 2.550781 (2021/04/02 7:17:15 )
test5_totalTime: 2.679688 (2021/04/02 7:20:35 )
 

Sub test5()
    
    Dim i As Long
    Dim t
    Dim endtime As Single
    
    Application.ScreenUpdating = False  '画面更新を停止
    Application.DisplayAlerts = False
    Application.Calculation = xlManual  '計算方法 手動
    
    t = Timer
    
    For i = 1 To 50
        With Range("A1").Resize(10000, 2)
            .ClearContents
            .Formula = "=row()"
            .Copy
            .PasteSpecial xlPasteValues
        End With
    Next
    
    endtime = Timer - t
    Debug.Print "test5_totalTime:"; endtime; " ("; Now(); ")"
    
    Application.ScreenUpdating = True '画面更新を再開
    Application.Calculation = xlAutomatic '計算方法 自動
    Application.DisplayAlerts = True
    ActiveWindow.Visible = True

End Sub

回答
投稿日時: 21/04/02 11:55:25
投稿者: Suzu

目的は、投稿日時: 21/03/10 14:47:16 の既存のコードの処理速度を上げる事ではないのでしょうか?
 
単純な数式 =Row() にて テストを行い、処理速度が速かった方法を
既存コードに適用したとして、他の方法より早いとは限りません。
 
 
回答者の方々は、数式 → 値 に置き換える 手法を提示しており
それらの手法を、取り込むかどうかのテストは ご自分の数式に置き換えてテストを行い評価するべきと思いますよ。

投稿日時: 21/04/19 09:52:47
投稿者: ip8bk

simple様
 
以前下記のご回答をいただいており、ご説明いただきました通り.Caluculateは必要ありませんでした。
必要ない理由を調べましたが、明確な答えが見つかりません。。。
 
必要ない理由をご教示いただけないでしょうか?
よろしくお願いいたします。
 

引用:
(1).Calculateは不要ではないでしょうか。それを無くしても速度はさほど向上しないと思いますが、
   なくても同じ結果のはずです。
   =ROW()と入力すれば、式入力に伴ってそれに対応する値はセットされるわけで、
   わざわざCalculate命令を実行する必要はないものと考えます。
   手動計算にしているのは、もちろん再計算を抑止するものですが、当該変更されたセルの
   計算がされないことは意味しないと思います。

回答
投稿日時: 21/04/19 20:34:38
投稿者: simple

> 必要ない理由をご教示いただけないでしょうか?
とのお尋ねですが、既に書いたとおり、
> 式入力に伴ってそれに対応する値はセットされるわけで、
> わざわざCalculate命令を実行する必要はないものと考えます。

これ以上のことはありません。

回答
投稿日時: 21/04/20 08:21:30
投稿者: eden

公式ではないですが、
https://excel-ubara.com/excelvba4/EXCEL_VBA_414.html

引用:
手動計算になっていても、
セルに計算式を入れた場合は、計算式を入れたセルについては必ず計算が行われます。

数式は =Row() ですので、問題ありません。
 
但し、
Range("B2:F10").FormulaR1C1="=r[1]c[-1]+1"
のように、数式を入れるセルと計算で参照するセルの範囲が重なっていると
数式を入れるセルは0と扱われるようで、セルには1と表示されます。
そして.Value=.Vlaue とすると1のままになります。
なのでこちらは再計算が必要です。

回答
投稿日時: 21/04/20 10:12:06
投稿者: simple

コメントありがとうございます。
 
Application.Calculation = xlCalculationAutomatic
でそうしたものについては追いつき処理されるので、
書込処理の効率化には役立つものと考えました。
Application.Calculation = xlCalculationAutomatic
の処理の前に、.Value=.Valueとしていたら、ご指摘のことが起きますね。
 
加えて言えば、書込対象範囲の前方参照(右側または下側にあるセルの参照)のみならず、
書込対象範囲のセルの値に依存する書込範囲外のセルを参照しているものがあれば、
書込対象範囲.Calculateでは再計算されませんから、
Application.Calculation = xlCalculationAutomatic
なり、シート.Calculate等で、シート全体を再計算させる必要はあるでしょう。

トピックに返信