0

お世話になります。

作成済みRPAで不具合があり、質問です。

ノード:Excelマクロ実行後、Excelマクロで、マクロとは別ファイル・容量が重いファイル(5MB程度)を開き、データ貼付け処理→ 15ファイル程度、繰り返し処理しています。

※貼り付けデータ自体も重く20MB程度あり。

先日、一部データが貼りついていないとユーザーより不具合連絡があり、検証したところ、Excelマクロをステップ実行すると正常に貼付け完了することを確認。RPA上で稼働させると、貼り付けがうまくいきません。

ちなみに、今回不具合連絡があったユーザーは、ループ処理で一番最初に処理するファイルを使っているユーザーです。

考えられる原因と、解決アドバイスがあればご教授いただきたいです。

 

<21/11/18追記>

5MBのファイルを開き、データ貼付け→保存、一連のループ処理は、マクロの中ですべて実施しています。

長くて見づらいですが、下記Excelマクロ内容です。

あと、昨日記載した情報で1つ訂正です。

データ貼り付けする元データのファイル容量は、20MB程度と記載しましたが、20MB程度ありました。

<マクロ処理概要>

①作業ファイル(パラメータファイル)より、処理対象ファイル(5MB)を選定

②元データより該当データをピックアップ

③①で選定した処理対象ファイルに貼付け→貼付け後のシートで数式設定など微調整

④①~③の作業を、処理対象ファイルがなくなるまで繰り返し処理=処理件数:15ファイル程度

<マクロ記述内容>
Sub マスタ()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual '手動計算

Application.DisplayAlerts = False
Const MyPath As String = "\\mm\在庫管理\"
Dim sh As Worksheet
Dim LR As Long, LR2 As Long, LR3 As Long, LR4 As Long, LR5 As Long
Dim ParameterFile As Workbook
Dim File As Workbook, 一時File As Workbook, 完成File As Workbook
Dim 条件 As String

Workbooks.Open Filename:=MyPath & "作業ファイル\作業ファイル.xlsx", ReadOnly:=True
Set ParameterFile = ActiveWorkbook
Set sh = Worksheets("全データ_賞味_2")

Workbooks.Open Filename:=MyPath & "元データ\マスタデータ.csv", ReadOnly:=True
'Workbooks.Open Filename:=MyPath & "元データ\VRHMマスタデータ.csv"
Set File = ActiveWorkbook

'21/1追加 レコード更新日時・K列を降順にする '21/2追加 登録終了日を降順にする(999999がヒットするように)
  Range("A1").Sort key1:=Range("k1"), order1:=xlDescending, key2:=Range("g2"), order2:=xlDescending, Header:=xlYes

'ソート前のM最終行
LR3 = File.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row

              
Workbooks.Add
Set 一時File = ActiveWorkbook '分割文字列で取得した管理単位CDでMをソート→完成ファイルにデータ貼付け

    '---対象企業の管理単位ーCDでソート
    '→PT→貼付けを最終企業まで繰り返す---
   
    ParameterFile.Activate
    sh.Select
    Dim buf
    Dim i As Integer
    LR = Cells(Rows.Count, 6).End(xlUp).Row
   
    '1、H列2行目以降最終行までループ
    For i = 2 To LR
   
        '(1)対象セル内に;があるか判定し、ある場合は;で文字分割

        If InStr(Cells(i, 7), ";") > 0 Then  'H列に;があったら
             buf = Split(Cells(i, 7), ";")  ';で文字列分割
            
             Dim j As Integer
             For j = LBound(buf) To UBound(buf)    '分割後の要素数

                  If buf(j) = "" Then       '分割後の文字が空白だったら何もしない(基本発生しない)
                  Else '空白以外だったら処理(取得要素で在庫Mをソート→可視セルを一時Fに貼付け)

                     LR2 = 一時File.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
                        
                        '分割した文字列条件でソート
                         File.Worksheets(1).Range("a1").AutoFilter field:=1, Criteria1:=buf(j)

                '21/2追加 Mに条件(j)のデータがあったら(データがない場合がある)
                  On Error Resume Next 'データがなかった場合のエラー回避

                        '可視セルのみコピぺ
                        File.Worksheets(1).Range("A2:EY" & LR3).SpecialCells(xlCellTypeVisible).Copy 一時File.Worksheets(1).Range("A" & LR2)
                        
                     'オートフィルター解除
                     File.Worksheets(1).ShowAllData
                    End If
             Next j
       
        Else
       
        '[;]が無かったら次処理(対象セル値を条件にして在庫Mソート→可視セルコピペ)

            条件 = sh.Cells(i, 7)
            File.Worksheets(1).Range("a1").AutoFilter field:=1, Criteria1:=条件

            '可視セルのみコピぺ
            File.Worksheets(1).Range("A2:EY" & LR3).SpecialCells(xlCellTypeVisible).Copy 一時File.Worksheets(1).Range("A2")

            If File.Worksheets(1).AutoFilterMode = True Then 'フィルタがかかっていたら
                 'オートフィルター解除
                Range("a1").AutoFilter
            End If
           
        End If

        '(2)入出庫リストに転記
        ParameterFile.Activate
       
   '     sh.Select
   
        Dim filepath As String
        filepath = Cells(i, 10).Value
       
         '読み取り専用か判断し、読み取り専用でなければ処理。読み取り専用だったら未処理&エラーメール送信
        Workbooks.Open Filename:=Cells(i, 10), notify:=False 'notify:=False 読み取り専用時、通知ボタンではなく読み取り専用ボタンを押す
        Set 完成File = ActiveWorkbook
        If ActiveWorkbook.ReadOnly Then
           
            'メール送信
              Dim myOLApp As Object
              Dim myDATA As Object
              Dim MsgBoxRet As String
              Set myOLApp = CreateObject("Outlook.Application")
              Set myDATA = myOLApp.CreateItem(olMailItem)
              '宛先
              myDATA.To = "m@n.com"
              '件名
              myDATA.Subject = "貼り付け時読み取り専用エラー"
              '本文
              myDATA.Body = i & "行目ファイルは読み取り専用でした。" & vbCrLf & "未処理で次行処理に移行します。"
              '送信
              myDATA.Send
              '変数値クリア
              Set myDATA = Nothing
              Set myOLApp = Nothing
             
              ActiveWorkbook.Close
             
             
        Else '読み取り専用でなければ処理開始
       
                '手動計算設定
                Application.Calculation = xlCalculationManual
               
                'フィルタがかかっていたら解除
                If 完成File.Worksheets("マスタデータ").AutoFilterMode = True Then
                    完成File.Worksheets("マスタデータ").Range("a1").AutoFilter
                End If
       
                '前回クリア処理
                LR5 = 完成File.Worksheets("マスタデータ").Cells(Rows.Count, 2).End(xlUp).Row + 5 '見出し削除された場合の回避+5(少し多めに行設定)
                完成File.Worksheets("マスタデータ").Range("a4:s" & LR5).Clear
       
                LR4 = 一時File.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
               
                '完成ファイルに、更新したデータを貼付け
                一時File.Worksheets(1).Range("A2:r" & LR4).Copy 完成File.Worksheets("マスタデータ").Range("B4")
          
                'A列数式設定(複合コード)'21/1~改修 登録&管理単位&商品CD
                完成File.Worksheets("マスタデータ").Range("a4") = "=b4&c4&d4"
                完成File.Worksheets("マスタデータ").Range("a4:a" & LR4 + 4).FillDown
               
                'フィルターをかける
                完成File.Worksheets("マスタデータ").Range("a3").AutoFilter

                '完成Fを保存して閉じる
                完成File.Close True
                Application.Wait Now() + TimeValue("00:00:01")
         End If
        
        
        '一時ファイルデータクリア
        一時File.Worksheets(1).UsedRange.Clear
        '次処理
        ParameterFile.Activate
       
      DoEvents 'フリーズ回避
 Next i
  
   

    一時File.Close False
    File.Close False
   

Application.Calculation = xlCalculationAutomatic  '自動計算
Workbooks("作業ファイル.xlsx").Close False

Application.ScreenUpdating = True '画面更新再開

End Sub

Zawawa 新しいコメントを投稿
回答とコメントは、会員登録(無料)で閲覧できるようになります。