【Excel・VBA】自動見積「通常・特別価格」任意の(顧客別の)価格データを自動挿入

Option Explicit

Sub Sample()

'画面更新STOP
Application.ScreenUpdating = False

  Dim mySht1 As Worksheet
  Dim A, B, myPath As String
    A = "Sheet1"
      Set mySht1 = ThisWorkbook.Worksheets(A)
    B = mySht1.Range("C4")
  
    myPath = "★★★★★★"
'「★★★★★★」の箇所に　[プロパティ]→[全般]→[場所]　をコピペ。必ず最後に「¥」を１つ追記して下さい。
 
 
  Dim myBook1, myBook2 As Workbook
  Dim myRng1, myRng2, myRng3, myRng4 As Range
  Dim result As Variant
  Dim EndLine1, i As Long
 
  Set myBook1 = Workbooks.Open(myPath & "1000" & ".xlsx")  '通常単価No.1000
  Set myRng1 = myBook1.Sheets("List").Range("A:A")    '商品名
  Set myRng2 = myBook1.Sheets("List").Range("B:B")    '単価①
    
  EndLine1 = mySht1.Cells(Rows.Count, 3).End(xlUp).Row  '最終行取得
    
'///①「お客様No.」が1000の場合
  If mySht1.Range("C7") <> "" And B = "1000" Then
    
    For i = 7 To EndLine1
      result = Application.XLookup(mySht1.Cells(i, 3), myRng1, myRng2, "", 0, 1)
        If Not IsError(result) Then
          mySht1.Cells(i, 4) = result
        End If
    Next i
      myBook1.Close
'①「お客様No.」が1000の場合///
  
'///②-1「お客様No.」が未記載ではない場合
  ElseIf mySht1.Range("C7") <> "" And B <> "" Then
       
'///②-2エラーになった場合は「myError」まで飛ぶ
On Error GoTo myError
              
    Set myBook2 = Workbooks.Open(myPath & B & ".xlsx")
    Set myRng3 = myBook2.Sheets("List").Range("A:A")    '商品名
    Set myRng4 = myBook2.Sheets("List").Range("B:B")    '単価②
        
        For i = 7 To EndLine1
          result = Application.XLookup(mySht1.Cells(i, 3), myRng3, myRng4, "", 0, 1)
            If Not IsError(result) Then
              mySht1.Cells(i, 4) = result
            End If

'///②-3「お客様No.」の特別単価には該当する商品名がない場合
            If mySht1.Cells(i, 4) = "" Then
              result = Application.XLookup(mySht1.Cells(i, 3), myRng1, myRng2, "", 0, 1)
               mySht1.Cells(i, 4) = result
            End If
'②-3「お客様No.」の特別単価には該当する商品名がない場合///
        
        Next i

    myBook1.Close
    myBook2.Close
  
'②-1「お客様No.」が未記載ではない場合///
'///③「お客様No.」が未記載の場合
  ElseIf mySht1.Range("C7") <> "" And B = "" Then
        
      For i = 7 To EndLine1
        result = Application.XLookup(mySht1.Cells(i, 3), myRng1, myRng2, "", 0, 1)
          If Not IsError(result) Then
            mySht1.Cells(i, 4) = result
          End If
      Next i
  
    myBook1.Close
    
  End If
'③「お客様No.」が未記載の場合///

Exit Sub
'エラーが無ければここで処理は終了///


'///②-2エラーが有った場合、以下の処理を実行する
myError:
  MsgBox "No." & B & "は存在しません" & vbCrLf & "No.1000を記載します", vbExclamation
  
    For i = 7 To EndLine1
      result = Application.XLookup(mySht1.Cells(i, 3), myRng1, myRng2, "", 0, 1)
        If Not IsError(result) Then
          mySht1.Cells(i, 4) = result
        End If
    Next i
  
  myBook1.Close
    
End Sub