転記作業を短縮させるには

投稿者 : けあらし     投稿日時 : 2024/12/04(Wed) 10:00:44     OS : Windows 11     EXCEL : Office 365

---

現在、油種別に作成されたファイルが50程あります。
毎日、日経データからその値を転記元ファイルに入力し、マクロで転記しております。

手作業だと、30分近くかかりますが、マクロでは5分かかります。
さらに、短縮させる事は不可能でしょうか。

お知恵をお借りしたく投稿しました。
よろしくお願い致します。

Option Explicit

'ファイルパス       'Parhを定数にする
    Const path As String = "C:\Users\Owner\Desktop\転記処理　日経平均\日経平均転記\"
    Const path2 As String = "C:\Users\Owner\Desktop\転記処理　日経平均\日経平均転記_予備\"
  

'一括処理ボタン押下時
Sub tenki()
    Dim buf As String                       'ファイル名
    Dim cnt As Long                         'ファイル数
    Dim wb As Workbook                      '開いたブック
    Dim ws As Worksheet                     '開いたシート
    Dim MeisaiRowCnt As Long             　 'ファイルの最終行数
    Dim MeisaiRetsuDay As String         　 '日付の列
    Dim MeisaiRetsuRyo As String          　'数量の列
    Dim MeisaiRetsuDay2 As String        　 '日付の列2
    
    '変数の設定　デスクトップ\日経平均処理\日経平均転記\日経*.xlsx
    buf = Dir(path & "日経*.xlsx")
    
    '画面のちらつきを停止する
    Application.ScreenUpdating = False
    '処理時間を計測開始
    Dim startTime As Double: startTime = Timer
    
    'ファイルをオープンして、書き込む
    Do While buf <> ""
    
        'ファイル名を取得する
         cnt = cnt + 1
         
        'ファイル選択
        Set wb = Workbooks.Open(path & buf)
        
        '一番左のシートを選択
        Set ws = wb.Worksheets(1)
        
        '海上保安学校は別のセルに書き込む
        If InStr(buf, "海上保安") <> 0 Then
            MeisaiRetsuDay = "F"
            MeisaiRetsuRyo = "G"
            MeisaiRetsuDay2 = "D"
        Else
            MeisaiRetsuDay = "H"
            MeisaiRetsuRyo = "I"
            MeisaiRetsuDay2 = "F"
        End If

        '書き込む行番号を取得
        If ws.Cells(7, MeisaiRetsuDay) <> "" Or ws.Cells(8, MeisaiRetsuDay) <> "" Then
            MeisaiRowCnt = ws.Cells(32, MeisaiRetsuDay).End(xlUp).Row           '行数を変更　30行→32行
        Else
            If ws.Cells(7, MeisaiRetsuDay2) <> "" Then
                MeisaiRowCnt = 6
            Else
                MeisaiRowCnt = 7
            End If
        End If
        
        '明細に書き込む
        ws.Cells(MeisaiRowCnt + 1, MeisaiRetsuDay).Value = wsTenki.Range("D2")      '日付
        
        '油種
        If Mid(buf, 5, 2) = "灯油" Then
            ws.Cells(MeisaiRowCnt + 1, MeisaiRetsuRyo).Value = wsTenki.Range("D4")  '灯油（高値）
        ElseIf Mid(buf, 5, 2) = "Ａ重" Then
            ws.Cells(MeisaiRowCnt + 1, MeisaiRetsuRyo).Value = wsTenki.Range("D7")  'A重油
        ElseIf Mid(buf, 5, 2) = "ガソ" Then
            ws.Cells(MeisaiRowCnt + 1, MeisaiRetsuRyo).Value = wsTenki.Range("D3")  'レギュラーガソリン
        ElseIf Mid(buf, 5, 2) = "灯安" Then
            ws.Cells(MeisaiRowCnt + 1, MeisaiRetsuRyo).Value = wsTenki.Range("D5")  '灯油（安）
        Else
            ws.Cells(MeisaiRowCnt + 1, MeisaiRetsuRyo).Value = wsTenki.Range("D6")  '軽油（安）
        End If
        
        '上書き保存
        wb.Save
        'ブックを閉じる
        wb.Close
        
        '次のファイル
        buf = Dir()
    Loop
    
    '画面のちらつきを再開する
    Application.ScreenUpdating = True
    
    '前回処理日を表示
    wsTenki.Range("D10").Value = wsTenki.Range("D2")


     '処理時間を表示する
     MsgBox "データの入力処理が完了しました。" & vbCrLf & _
                  "処理時間:" & Timer - startTime & "秒"

End Sub

投稿者 : さんこう     投稿日時 : 2024/12/04(Wed) 10:34:33

---

＞ファイルが50程あります。
＞手作業だと、30分近くかかりますが、マクロでは5分かかります。

1ファイルあたり6秒程度ですから、ファイルの読み書きだけでもそのくらいかかると思いますが。


＞さらに、短縮させる事は不可能でしょうか。

可能性としては、

・セルの書き込みに時間がかかるのであれば、再計算の停止

・ファイルのオープン/保存/クローズに時間がかかるのであれば、SSDなどの高速ストレージの利用

などがあるかと思います。

投稿者 : tek     投稿日時 : 2024/12/05(Thu) 07:43:05

---

この掲示板の趣旨に反するかもしれませんが、なぜ同じデータを複数のブックに転記するのでしょう。
日々のデータを1ブックに転記して各ブックはそのブックのデータを参照すれば転記作業は短縮されるのではと思います。

例えば以下のように、C:¥Users¥Owner¥Desktop¥転記処理　日経平均¥日経平均転記_予備¥価格.xlsxのSheet1に蓄積したとして
　　　　A　　　　　　　B　　　　　　　C　　　　　　　　D　　　　　　　　　　　E　　　　　　　　F
-1-　　日付　　　　灯油（高値）　　A重油　　　　レギュラーガソリン　　　　灯油（安）　　　　軽油（安）
-2-　　12月1日　　　　　　131　　　　　88　　　　　　　　　　168　　　　　　　　120　　　　　　　　93
-3-　　12月2日　　　　　　132　　　　　88　　　　　　　　　　169　　　　　　　　121　　　　　　　　120
-4-　　12月3日　　　　　　132　　　　　88　　　　　　　　　　169　　　　　　　　122　　　　　　　　120

日経海上保安.xlsxのWorksheets(1)のF6に
=IF('C:¥Users¥Owner¥Desktop¥転記処理　日経平均¥日経平均転記_予備¥[価格.xlsx]Sheet1'!$A2:$A32="","",'C:¥Users¥Owner¥Desktop¥転記処理　日経平均¥日経平均転記_予備¥[価格.xlsx]Sheet1'!$A2:$A32)

日経海上保安.xlsxのWorksheets(1)のG6に
=IF('C:¥Users¥Owner¥Desktop¥転記処理　日経平均¥日経平均転記_予備¥[価格.xlsx]Sheet1'!$F2:$F32="","",'C:¥Users¥Owner¥Desktop¥転記処理　日経平均¥日経平均転記_予備¥[価格.xlsx]Sheet1'!$F2:$F32)

などとしてもし必要であれば、
[ファイル] > [オプション] > [詳細設定] を選択し、「全般」の下の [リンクの自動更新前にメッセージを表示する] チェック ボックスをオフにしておき、
さらに必要なら月末にでもセル参照式を値に変換すれば良いのではと思います。

（価格なのか数量なのかは？です）