Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7 Home Premium : Excel 2010)
マクロが遅い
投稿日時: 19/10/31 14:29:02
投稿者: ロックさん

はじめて質問させて頂きます。
 
フォルダーにtxtファイルが1500あります。
そのtxtファイルを任意に500、個々にエクセルで開き、検証してエクセルに一覧表作成するマクロですが、最初はファイルの開閉は速いのですが300個位になるとほとんど停止のような状態になります。
以前はもっと速かったのですが何が考えられますでしょうか
 
よろしくお願いいたします。

回答
投稿日時: 19/10/31 17:58:08
投稿者: WinArrow
投稿者のウェブサイトに移動

コードの内容と
処理の概要を
説明できますか?

投稿日時: 19/11/01 07:10:34
投稿者: ロックさん

長くなりますがコードを記入します。
日足フォルダーに株価データtxtが1800あります、1ファイル150kb位。
USB(2.0)に日足フォルダーを入れて日々更新しています。
動作が遅くなったのでDドライブに入れて実行しても速度は同じ位です。
Dドライブの方がUSBよりアクセスが速いと思っていたので意外でした。
 
株価の検証にはパンローリングのPan Active Marketを使用してエクセルで処理していますが
パンローリングの日足データは株価の分割統合情報がないので過去の株価を分割後の株価に
修正出来ません。それで分割統合銘柄は某サイトよりDLしています
過去1年分の検証ではPan Active Marketで処理出来ない300銘柄位はファイルを参照しています。
各マクロを個々に実行すると(ファイルを開いて実行終了閉じる)と40から60秒ですが3個一緒ですと8分かかります。
 
    以下コード
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
Application.EnableEvents = False
Cancel = True
    If Target.Address = "$A$1" Then
        Application.Run "'D:\Rock\日転換.xlsm'!日転換検索"
        Workbooks("日転換.xlsm").Close True
        Application.Run "'D:\Rock\週転換.xlsm'!週転換検索"
        Workbooks("週転換.xlsm").Close True
        Application.Run "'D:\Rock\月転換.xlsm'!月転換検索"
        Workbooks("月転換.xlsm").Close True
    End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 
 
'週転換検索と月転換検索も同様のマクロです。
Sub 日転換検索()
'4日移動平均と終値の比較する。上ならその日付を赤、下なら青で表示
Dim sS As Worksheet, r As Long, c As Long, iy As Long
Dim rr As Long, i As Long, ii As Long, cc As Long, endr As Long, endday As String, DD()
Dim ed As Long, endi As Long, lastr As Long, lasti As Long, startdayi As Long
    Set sS = Sheets("日転換")
'1列目:コード銘柄名(2000) 2列目:転換日 3列目:転換回数 5列目以降:転換日
  
    endr = sS.Cells(3000, 1).End(xlUp).Row
    endi = 8191 '最終日 Pan Active Market のコード
    endday = Calendar.Date(endi) '最終日
    startdayi = Calendar.DatePosition(DateAdd("d", 1, sS.Cells(3, 2)), 1) '更新日の翌営業日 Panのコード
    ed = Calendar.DatePosition(endday) - startdayi + 3 '更新日の翌営業日と最終日との日数+3
    ReDim DD(ed, 3)
    For i = 0 To ed
        DD(i, 0) = startdayi + i - 3 '0 Pan Active Market 日付のコード
        DD(i, 1) = Calendar.Date((DD(i, 0))) '1 日付
    Next i
 
    For r = 5 To endr
        c = sS.Cells(r, 1000).End(xlToLeft).Column + 1
        If sS.Cells(r, 1).Font.Color = vbBlack Then
         
'Pan Active Market のコード
            With Prices
                .ReadBegin = DD(0, 0)
                .Read Val(sS.Cells(r, 1))
                For i = 0 To ed
                    DD(i, 2) = .Close(DD(i, 0))
                    If i >= 3 Then DD(i, 3) = (DD(i - 3, 2) + DD(i - 2, 2) + DD(i - 1, 2) + DD(i, 2)) / 4
                Next i
                iy = 0
                For i = 3 To ed - 1
                    If DD(i, 3) < .Close(DD(i + 1, 0)) And iy <= 0 Then
' シートに転換日記入 省略
                    ElseIf DD(i, 3) > .Close(DD(i + 1, 0)) And iy >= 0 Then
' シートに転換日記入 省略
                    End If
                Next i
' シートに転換日記入 省略
            End With
'Pan Active Marketのコード ここまで
 
        Else
'日足フォルダーの株価txtを開きます 2列目より日付/始値/高値/安値/終値
            Workbooks.Open Dp & "\日足\" & Val(Cells(r, 1)) & ".txt"
            lastr = Cells(5000, 2).End(xlUp).Row
            ii = lastr
'最後行より 開始日 DD(0, 1)を検索して 4戻りDD(i, 3)に4日移動平均を入力
            Do Until DD(0, 1) = Cells(ii, 2)
                ii = ii - 1
            Loop
            rr = ii + 4
             
            For i = 0 To ed
                If i >= 3 Then DD(i, 3) = (Cells(ii - 3, 6) + Cells(ii - 2, 6) + Cells(ii - 1, 6) + Cells(ii, 6)) / 4
                ii = ii + 1
            Next i
'4日移動平均と終値を比較。転換していれば記入済の前列の転換と同転換でないなら記入(iy=1:陽転中 iy=-1:陰転中)
            iy = 0
            For i = 3 To ed - 1
                If DD(i, 3) < Cells(rr, 6) And iy <= 0 Then
                    If sS.Cells(r, c - 1).Font.Color <> vbRed Then
                        sS.Cells(r, c) = Cells(rr, 2)
                        sS.Cells(r, c).Font.Color = vbRed
                        c = c + 1: iy = 1
                    End If
                ElseIf DD(i, 3) > Cells(rr, 6) And iy >= 0 Then
                    If sS.Cells(r, c - 1).Font.Color <> vbBlue Then
                        sS.Cells(r, c) = Cells(rr, 2)
                        sS.Cells(r, c).Font.Color = vbBlue
                        c = c + 1: iy = -1
                    End If
                End If
                rr = rr + 1
            Next i
            cc = sS.Cells(r, 1000).End(xlToLeft).Column
            sS.Cells(r, 3) = c - 4
            sS.Cells(r, cc).Copy (sS.Cells(r, 2))
 
            ActiveWorkbook.Close savechanges:=False
        End If
    Next r
    sS.Cells(3, 2) = Calendar.Date(endi)
    Set sS = Nothing
End Sub
 
 

回答
投稿日時: 19/11/01 08:38:19
投稿者: WinArrow
投稿者のウェブサイトに移動

Pan Active Market
については、どのくらい影響しているのかわかりませんが、
 
テキストファイルが多いだけ・・・・というよりは
ちょっと見、シート(セル)に対するアクセス・ループが多いように思います。
メモリ(配列)に入れるか、別な方法を検討したほうがよいと思います。
 
 

投稿日時: 19/11/01 09:57:06
投稿者: ロックさん

回答ありがとうございます
 
Pan Active Marketについては影響はないと思います。
Pan Active Marketの株価データベースで処理するなら2000位の銘柄なら複雑なマクロでも
60秒はかからないと思います。
原因は1個で50秒なのが、3個のマクロをエクセルを閉じないで処理すると8分かかるところにあると思うのですが
ファイルを配列に取り込むことも考えましたが4行位取り込んでも効果あるんでしょうか
それとマクロの途中で止めて再開すると10ファイル位は速くなりますが、また遅くなります。

回答
投稿日時: 19/11/01 13:02:56
投稿者: simple

> 原因は1個で50秒なのが、3個のマクロをエクセルを閉じないで処理すると8分かかるところにあると思うのですが
・どこで時間がかかっているのか計測する
・Excelとして開かずに、textファイルとして開いて操作する。
  「4行位取り込んでも効果あるんでしょうか」と「1ファイル150kb位」の関係が不明。
  Excelとして開くと、構造を作るので、それなりに負荷がかかります。コードは書きやすくなりますが。
・シート書込はまとめて(配列利用)。
  着色処理があるので、無理かも。
・手動計算と自動計算の適宜な切り替え(外部ツールの関係で無理ですか?)
といった一般的な事しか浮かびませんが、参考になりますか。

回答
投稿日時: 19/11/01 13:16:56
投稿者: jung

試していませんが
 
Runメソッドは非同期のようなので
マクロ実行中にクローズされるのが
原因では?
 
試しにクローズをコメントにして
速くなりません?

回答
投稿日時: 19/11/01 15:21:07
投稿者: WinArrow
投稿者のウェブサイトに移動

>Runメソッドは非同期のようなので
 
これ・・・本当ですか?

回答
投稿日時: 19/11/01 15:42:01
投稿者: jung

>Runメソッドは非同期のようなので
 
ごめんなさい
 
色々調べたら同期っぽいですね
明確に同期とも見つからないんですけど
戻り値が取れるようなので同期っぽいです
 
WinArrowさんやsimpleさんがそんなことに
気付かないわけもありませんね
 
前レスはスルーしてください
 
あとわたしが感じたのが
呼び出す側にマクロを集められないものか

そうすれば速くなるとも言えませんが

投稿日時: 19/11/01 17:33:34
投稿者: ロックさん

ご迷惑をおかけしてすみません
 
>呼び出す側にマクロを集められないものか
最初は1個のbookに日転換検索、週転換検索、月転換検索の3シートを入れて
 
Sub 転換検索()
Application.ScreenUpdating = False
Application.EnableEvents = False
    Call 日転換検索
    DoEvents
    Call 週転換検索
    DoEvents
    Call 月転換検索
Application.ScreenUpdating = true
Application.EnableEvents = true
End Sub
 
で処理してましたが、動作がおそい(フリーズもします)ので3bookに分割してRunで処理になりました。
それと3マクロは全て同じファイル(285個)を開いています、つまり3回開いています。
全部で2031銘柄ありまして2031-285=1746はPan Active Marketを使用してActive Marketの株価データでの処理です。
これを3回繰り返しています。
 
>「4行位取り込んでも効果あるんでしょうか」と「1ファイル150kb位」の関係が不明。
今回のマクロは数行しか参照しませんが
1ファイル 700行位 日足、週足、月足、移動平均が11種のデータです。
このデータで各種の解析マクロやオリジナルチャートを作成してます。
Pan Active Marketのデータを使用出来るのであればファイルは不要なんですが東証の売買単位100株化の影響で株式統合が進み、過去の株価を修正しないと株価の連続性が失われます。
それでファイルがどんどん増えてます。
 
>どこで時間がかかっているのか計測する
遅くなり始めるのは3マクロ目の途中からです。
 
 

回答
投稿日時: 19/11/01 18:05:18
投稿者: WinArrow
投稿者のウェブサイトに移動

セルへのアクセスが多ければフリーズすることもあり得ます。
 
配列で捜査しておいて、一挙にシートに格納するようにします。
問題はmセルへの色設定ですが、
条件付き書式をセル範囲で設定できれば、
個々のセルに色を設定しなくてもよくなります。

投稿日時: 19/11/01 20:55:19
投稿者: ロックさん

何度も回答ありがとうございます
セルへ書き込みを停止して試しましたが変わりありませんでした。
明日、ファイルを参照する285銘柄だけのマクロを作って試してみます。

回答
投稿日時: 19/11/01 21:31:14
投稿者: simple

こんばんは。
 
そのテキストファイルはタブ区切りか何かですか?
多数のテキストファイルを読み込む場合は、
Excelではなく、単純にテキストファイルで読み込むようにすると
時間もメモリもたぶん節約できるはずです。
 
手元で700件6列くらいのデータで実験すると、
テキストで読み込んで配列に入れる処理に要する時間は、
だいたい 17 倍くらい違いますね。
 
そういえば、昔、そのような処理変更をした結果、
今まで7分くらいの処理が、3秒で終わったという相談例がありました。
これは、取得する情報がさほど多くなく、計算がかなり簡単なものだったのに、
CSVファイルをExcel形式で多数開閉していたことが原因でした。
ま、これは極端な例ですが、かなり効果はあるようには思います。
 
ただし、それに伴う変更負荷もありますから、判断が必要ですね。
拝見したところ、読み込んだあとの処理は繰り返し計算のようですから、
今の処理を配列に置き換えるだけなので、さほどの負荷はないようにも思いますが。
 
質問の最初に戻ると、今まではさほどでなかったとすると、
メモリなどのPC環境とか、ウイルス対応ソフトの影響とかもあるかもしれません。

投稿日時: 19/11/02 10:27:31
投稿者: ロックさん

何度も回答頂きましてありがとうございます
 
ファイル参照する銘柄285(3回ですので855)だけでエクセルへの書き込みを停止して実行しましたが
500位から速度が落ち、止まってそのままでフリーズしてしまいます。
 
マクロに何か問題があるかもしれませんが、過去にファイル読み込みエクセルに書き込むマクロ作成したか考えましたが、今も使用中のもので銘柄数1400位でファイルも2000開閉して8分程かかりますが、今回はど気にしていませんでしたので、こんなもんかと思っていました。
今すぐ結果をみたいマクロは30秒以上かかればストレスがたまりますよね
 
エクセルでファイルtxt読み込み計算ファイル書き込みマクロは このファイルtxtがそうですが
某サイトより日々株価更新DL 日足書き込み、日足より週足、月足、移動平均、分割統合があれば修正株価作成してファイルに書き込み保存します、1400で15から25分です。これも最近時間がかかるようになった気がします。
 
txtでの読み込みは管理マクロを作ってまして、分割統合があるとDLミスがよく起こりますので、フォルダー内を検索してミスファイルを書き出しますが、txtの最後行を検証してミス判定しますが1分、エクセルですと3分です。
日足DLの場合は計算にワークシート関数を使うので無理ですが、txtでの読み込みは詳しくないですが範囲を選択しの読み込みは出来るものでしょうか

回答
投稿日時: 19/11/02 13:24:04
投稿者: simple

> 範囲を選択しての読み込みは出来るものでしょうか
セル範囲的な指定の仕方をして、そこだけ取得するということですか?
難しいでしょうね。
(データが固定長ならいざ知らず、seekコマンドで、決め打ちすることは難しい?)
・行毎に読み込んでその都度判定して、読み込み不要になったら抜けるとかでしょうか。
・いったんすべて読み込んでから、Splitで分解して分析するといった方法が普通だと思います。
  日付で範囲抽出するなら、いったん全部を読み込んでから、正規表現でそこだけ
  取り込むなどということは可能かもしれません。
  

回答
投稿日時: 19/11/02 15:16:23
投稿者: WinArrow
投稿者のウェブサイトに移動

テキストファイルを、VBAで読込 → シートに格納するコードの例
 
Option Explicit
 
Sub TEST()
    Debug.Print Timer
    Dim R As Long, C As Long, ALLCELL
    Dim buf As String, REC1, REC2, LastRow As Long, FSO As Object
    Const Target As String = "G:\TEST\testA.txt"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With FSO.OpenTextFile(Target, 1)
        buf = .ReadAll
        .Close
    End With
    Set FSO = Nothing
    'レコードに分解
    REC1 = Split(buf, vbCrLf)
    ReDim ALLCELL(1 To UBound(REC1) + 1, 1 To 1)
    For R = LBound(REC1) To UBound(REC1)
         
        '項目に分解+作業用項目を追加
        REC2 = Split(REC1(R) & ",", ",")
        If R = 0 Then
            ReDim Preserve ALLCELL(1 To UBound(ALLCELL), 1 To UBound(REC2) + 1)
        End If
        For C = LBound(REC2) To UBound(REC2)
            ALLCELL(R + 1, C + 1) = REC2(C)
        Next
    Next
    Range("A1").Resize(UBound(ALLCELL), UBound(ALLCELL, 2)).Value = ALLCELL
    Debug.Print Timer
  End Sub
1万件程度でしたら、1秒もかかりません。

投稿日時: 19/11/03 18:35:29
投稿者: ロックさん

すもません、更新されているのに気が付きませんでした
 
書き込みは停止して、ファイルを配列で読み込み、エクセルも配列で試しましたが効果なし
結局、ファイル開閉だけでもためしましたが500くらいで停止状態になります。
株価DLマクロ(エクセルを介してファイル読み込み、書き込み)が1500処理しているので訳が分かりません。
1個づつ実行する分には支障ないので、他の方法も考えてみます。
 
WinArrowさん
「テキストファイルを、VBAで読込」コード ありがとうどざいました。
後で研究して、参考にさせて頂きます。それと
> '項目に分解+作業用項目を追加
 > REC2 = Split(REC1(R) & ",", ",") の&の意味は?
 
simpleさん、jungさん ありがとうございました。

回答
投稿日時: 19/11/03 18:56:29
投稿者: WinArrow
投稿者のウェブサイトに移動

>の&の意味は?
  
「作業列」の意味ですか?
作業列を使って、4日移動平均すればよいかな・・と思っただけです。
セルに格納してから計算するより、配列で計算してからセルに格納したほうが早いと思いました。

投稿日時: 19/11/03 20:35:37
投稿者: ロックさん

レベルが低くてすみません
 > REC2 = Split(REC1(R) & ",", ",") の Split(REC1(R) & のこの "&" 意味は?
この使い方は初めてなので

回答
投稿日時: 19/11/03 21:22:24
投稿者: WinArrow
投稿者のウェブサイトに移動

ロックさん さんの引用:
レベルが低くてすみません
 > REC2 = Split(REC1(R) & ",", ",") の Split(REC1(R) & のこの "&" 意味は?
この使い方は初めてなので

単純な文字列の結合です。
 
テキストデータは、
複数行のデータで構成されています。
区切り文字:vbCrLfで区切って、REC1(n)に格納します。
1つのデータは、「,」を区切り文字とした項目があるという前提です。
 
 
REC1(R) という文字列に「,」という、文字列を追加することにより
項目を1つ増やすことになります。
 
例えば、データが10項目だとして、「,」を付加することで11項目ということになります。
勿論、11項目目は空白文字列が入ります。
 
 

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

余談ですが、
 
ある文字列のデータがあったとして、
その中の、最初の「,」より左の文字列を取り出したい。
という課題があります。
条件として、「,」が存在しないこともある。
 
という場合、
「,」が存在するかをチェックする場合と、しない場合に分けて処理する
方法と
単純に「,」を追加することで、1つのコードで処理する方法
があります。
 
前者
If Instr(文字列,",") > 0 Then
   取り出し = Left$(文字列,InStr(文字列, ",")-1)
Else
   取り出し = 文字列
End If
 
後者
   取り出し = Left$(文字列,InStr(文字列 & ",", ",")-1)
 
後者の方が少ないコードで、処理が速い。

投稿日時: 19/11/04 11:08:41
投稿者: ロックさん

何度も、つきあって頂きありがとうございました。
 
どこにものっていないようなこと教えて頂きありがとうございます、
すぐには理解できませんが研究して、以後のマクロにいかしたいと思います。
 
マクロの遅い件については、私のパソコン環境でないと原因は分からなそうなので終了したいと思います。
みなさん、いろいろありがとうございました。