フォルダ内の特定ファイル特定シート特定セルの値を集計2

Option Explicit

Sub Prosess2()
    Dim wb As Workbook
    Dim tempPath As String
    Dim newPath As String
    Dim newWb As Workbook
    Dim lastRow As Long
    Dim strMonth As String
    Dim storagePath
    Dim val1 As String
    Dim val2 As String
    Dim TargetNum As Long
    Dim inputRow As Long
    Dim i As Long
      
'---------------------------------------------------------
   'マスタシートより各パスを取得
    strMonth = Format(Now, "M月")
    With ThisWorkbook.Sheets("マスタ")
        lastRow = .Cells(Rows.Count, 4).End(xlUp).Row
        tempPath = .Cells(3, 4).Value
        storagePath = .Cells(4, 4).Value
    End With
    
    '前月ファイルをコピーして今月集計ファイルを作成
    newPath = storagePath & "\" & strMonth & "集計.xlsx"
    Debug.Print newPath
    FileCopy tempPath, newPath
    
    '今月集計ファイルの入力箇所をクリアする
    Set newWb = Workbooks.Open(newPath)
    With newWb.Sheets("Sheet1")
        lastRow = .Cells(Rows.Count, 4).End(xlUp).Row
        .Range(Cells(5, 4), Cells(lastRow, 4)).ClearContents
    End With
'---------------------------------------------------------------
    Set newWb = Workbooks.Open(newPath)
    lastRow = 0
    
    lastRow = ThisWorkbook.Sheets("マスタ").Cells(Rows.Count, 4).End(xlUp).Row
    ThisWorkbook.Activate
    Set wb = ActiveWorkbook
    For i = 7 To lastRow
        val1 = wb.Sheets("マスタ").Cells(i, 2).Value
        val2 = wb.Sheets("マスタ").Cells(i, 3).Value
        If wb.Sheets("マスタ").Cells(i, 5) <> "フォルダ存在なし" Then
            TargetNum = wb.Sheets("マスタ").Cells(i, 9)
            inputRow = fncGetInputRow(newWb, val1, val2)
            newWb.Sheets("Sheet1").Cells(inputRow, 4) = TargetNum
        End If
    Next
    newWb.Close (True)
    MsgBox "おわり"
End Sub
Function fncGetInputRow(wb As Workbook, val1 As String, val2 As String) As Long
'----------------------------------------------
'機能:2つの検索値に合致するセルの行数を返す
'引数1:検索対象のワークブックオブジェクト
'引数2:検索値の文字列1
'引数3：検索値の文字列2
'戻り値: 検索値の組み合わせに合致する行数
'----------------------------------------------
    Dim i As Variant            '行数格納用変数
    Dim strCalc As String       '計算式格納用
'----------------------------------------------
    val1 = Chr(34) & val1 & Chr(34)
    val2 = Chr(34) & val2 & Chr(34)
    '検索対象ブックを選択
    wb.Sheets("Sheet1").Activate
    '計算式の文字列を変数に格納
    strCalc = "SUM((B1:B15=" & val1 & ")*(C1:C15=" & val2 & ")*ROW(B1:B15))"
    'ログ出力
    Debug.Print strCalc
    '検索対象の行を検索
    i = Evaluate(strCalc)
    '検索対象業が見つかったら戻り値を返す
    If i <> 0 Then
            fncGetInputRow = i
     Else
            fncGetInputRow = 0
            MsgBox "該当のデータが見つかりません", vbExclamation
     End If
End Function

ray88.hatenablog.com
ray88.hatenablog.com