Excelランタイムエラー '13'：タイプミスマッチコードの問題

Question

私はこのコードで作業しており、エラーが発生しています。すべてコンパイルされますが、実行時エラーが発生します。私は2つの異なるシートを比較して、一致しないセルを強調表示しようとしています。私はどこにエラーが発生しているのかわかりません。どんな助けでも大歓迎です。最後のエラーのためとして

Sub David() 

Dim Initial_PO As Double 
Dim Initial_Firmed As Range 
Dim Initial_Agreed_Ship As Range 
Dim Initial_Actual_Ship As Range 
Dim Initial_Agreed_Delivery As Range 
Dim Initial_Actual_Delivery As Range 
Dim Initial_Requested_Quantity As Range 
Dim Initial_Actual_Quantity As Range 
Dim Initial_QMetric As Double 
Dim Initial_DMetric As Double 
Dim Final_PO As Double 
Dim Final_Firmed As Range 
Dim Final_Agreed_Ship As Range 
Dim Final_Actual_Ship As Range 
Dim Final_Agreed_Delivery As Range 
Dim Final_Actual_Delivery As Range 
Dim Final_Requested_Quantity As Range 
Dim Final_Actual_Quantity As Range 
Dim Final_QMetric As Double 
Dim Final_DMetric As Double 
Dim Initial_Agreed_Delivery_Date As Date 
Dim Final_Agreed_Delivery_Date As Date 
Dim Initial_Actual_Delivery_Date As Date 
Dim Final_Actual_Delivery_Date As Date 
Dim Today As Date 

'Dim NumRow As Integer 
Dim i As Long 
Dim BulkLT As Double 




For i = 2 To 3000 

Sheets("Initial").Select 
Set Initial_PO = Cells(i, 7) 
Set Initial_Firmed = Cells(i, 9) 
Set Initial_Agreed_Ship = Cells(i, 10) 
Set Initial_Actual_Ship = Cells(i, 11) 
Set Initial_Agreed_Delivery = Cells(i, 13) 
Set Initial_Actual_Delivery = Cells(i, 14) 
Set Initial_Requested_Quantity = Cells(i, 15) 
Set Initial_Actual_Quantity = Cells(i, 16) 

Sheets("Final").Select 
Set Final_PO = Cells(i, 7) 
Set Final_Firmed = Cells(i, 9) 
Set Final_Agreed_Ship = Cells(i, 10) 
Set Final_Actual_Ship = Cells(i, 11) 
Set Final_Agreed_Delivery = Cells(i, 13) 
Set Final_Actual_Delivery = Cells(i, 14) 
Set Final_Requested_Quantity = Cells(i, 15) 
Set Final_Actual_Quantity = Cells(i, 15) 


'Initial Highlighting 
If (Initial_PO = Final_PO) Then 
    If Not (Initial_Firmed = Final_Firmed) Then 
     Initial_Firmed.Interior.Color = RGB(225, 225, 0) And Final_Firmed.Interior.Color = RGB(225, 225, 0) 
    End If 

    If Not (Initial_Agreed_Ship = Final_Agreed_Ship) Then 
     Initial_Agreed_Ship.Interior.Color = RGB(225, 225, 0) And Final_Agreed_Ship.Interior.Color = RGB(225, 225, 0) 
    End If 

    If Not (Initial_Actual_Ship = Final_Actual_Ship) Then 
     Initial_Actual_Ship.Interior.Color = RGB(225, 225, 0) And Final_Actual_Ship.Interior.Color = RGB(225, 225, 0) 
    End If 

    If Not (Initial_Agreed_Delivery = Final_Agreed_Delivery) Then 
     Initial_Agreed_Delivery.Interior.Color = RGB(225, 225, 0) And Final_Agreed_Delivery.Interior.Color = RGB(225, 225, 0) 
    End If 

    If Not (Initial_Actual_Delivery = Final_Actual_Delivery) Then 
     Initial_Actual_Delivery.Interior.Color = RGB(225, 225, 0) And Final_Actual_Delivery.Interior.Color = RGB(225, 225, 0) 
    End If 

    If Not (Initial_Requested_Quantity = Final_Requested_Quantity) Then 
     Initial_Requested_Quantity.Interior.Color = RGB(225, 225, 0) And Final_Requested_Quantity.Interior.Color = RGB(225, 225, 0) 
    End If 

    If Not (Initial_Actual_Quantity = Final_Actual_Quantity) Then 
     Initial_Actual_Quantity.Interior.Color = RGB(225, 225, 0) And Final_Actual_Quantity.Interior.Color = RGB(225, 225, 0) 
    End If 

    If Not (Initial_Requested_Quantity = Initial_Actual_Quantity) Then 
     Initial_Requested_Quantity.Interior.Color = RGB(225, 225, 0) And Initial_Actual_Quantity.Interior.Color = RGB(225, 225, 0) 
    End If 

    If Not (Final_Requested_Quantity = Final_Actual_Quantity) Then 
     Final_Requested_Quantity.Interior.Color = RGB(225, 225, 0) And Final_Actual_Quantity.Interior.Color = RGB(225, 225, 0) 
    End If 

'Metric Calculation 
    Initial_QMetric = ((Initial_Actual_Quantity/Initial_Requested_Quantity) * 100) 
    Final_QMetric = ((Final_Actual_Quantity/Final_Requested_Quantity) * 100) 
    Sheets("Initial").Select 
    Cells(i, 27) = Initial_QMetric 
    Sheets("Final").Select 
    Cells(i, 27) = Final_QMetric 

    If (Initial_QMetric < 90 Or Initial_QMetric > 110) Then 
     Sheets("Initial").Select 
     Cells(i, 27).Interior.Color = RGB(225, 225, 0) 
    End If 

    If (Final_QMetric < 90 Or Final_QMetric > 110) Then 
     Sheets("Final").Select 
     Cells(i, 27).Interior.Color = RGB(225, 225, 0) 
    End If 


    Initial_DMetric = DateDiff("d", Initial_Agreed_Delivery_Date, Initial_Actual_Delivery_Date) 
    Final_DMetric = DateDiff("d", Final_Agreed_Delivery_Date, Final_Actual_Delivery_Date) 
    Sheets("Initial").Select 
    Cells(i, 28) = Initial_DMetric 
    Sheets("Final").Select 
    Cells(i, 28) = Final_DMetric 

    If (Initial_DMetric > 5 Or Initial_DMetric < (-5)) Then 
     Sheets("Initial").Select 
     Cells(i, 28).Interior.Color = RGB(225, 225, 0) 
    End If 

    If (Final_DMetric > 5 Or Final_DMetric < (-5)) Then 
     Sheets("Final").Select 
     Cells(i, 28).Interior.Color = RGB(225, 225, 0) 
    End If 

'Bulk Lead time 

    BulkLT = DateDiff("d", Today, Final_Agreed_Ship) 

    If IsEmpty(Final_Firmed) = True Then 
     If (BulkLT < 90) Then 
      Final_Firmed.Interior.Color = RGB(225, 225, 0) 
     End If 
    End If 


Else: MsgBox ("PO Numbers in row" & i & "do not match") 
End If 
Next i 

End 
End Sub 

Answer 1

、あなたは値型（Dim Initial_PO As Double）としてInitial_POを暗くして、object（Set Initial_PO = Cells(i, 7)）として設定しようとしている：あなたは、タイプ（値またはオブジェクト）を選択し、その後、Dあなたのコード上でより多くの制御を取得し、それら

は最終的にあなたがしているの範囲を参照し、Select()方法とSelectionプロパティを回避することにより、その実行時間を短縮することができ、一貫さらに

働きます多くのコードをuplicating、これも不要なタイプミスと緩いコード管理あなたはこのコードを検討する必要があります上記のものをすべてのための

につながることができます：

私もいくつかの小さな調整を行わ

Option Explicit 

Sub David() 
    Dim initialSht As Worksheet: Set initialSht = Worksheets("Initial") 
    Dim finalSht As Worksheet: Set finalSht = Worksheets("Final") 
    Dim i As Long, lastRow As Long 

    lastRow = initialSht.Cells(initialSht.Rows.Count, 7).End(xlUp).Row 'get the "Initial" last non blank row index in column 7 
    For i = 2 To lastRow 
     If initialSht.Cells(i, 7) = initialSht.Cells(i, 7) Then 
      DoChecksAndFormat initialSht, finalSht, i 
     Else 
      MsgBox ("PO Numbers in row '" & i & "' do not match") 
     End If 
    Next i 
End Sub 


Sub DoChecksAndFormat(initialSht As Worksheet, finalSht As Worksheet, i As Long) 
    Dim Initial_Firmed As Range 
    Dim Initial_Agreed_Ship As Range 
    Dim Initial_Actual_Ship As Range 
    Dim Initial_Agreed_Delivery As Range 
    Dim Initial_Actual_Delivery As Range 
    Dim Initial_Requested_Quantity As Range 
    Dim Initial_Actual_Quantity As Range 
    Dim Initial_QMetric As Double 
    Dim Final_Firmed As Range 
    Dim Final_Agreed_Ship As Range 
    Dim Final_Actual_Ship As Range 
    Dim Final_Agreed_Delivery As Range 
    Dim Final_Actual_Delivery As Range 
    Dim Final_Requested_Quantity As Range 
    Dim Final_Actual_Quantity As Range 
    Dim Initial_Agreed_Delivery_Date As Date 
    Dim Final_Agreed_Delivery_Date As Date 
    Dim Initial_Actual_Delivery_Date As Date 
    Dim Final_Actual_Delivery_Date As Date 

    Dim BulkLT As Double 

    'initialize your relevant variables 
    Init initialSht, i, Initial_Firmed, Initial_Agreed_Ship, Initial_Actual_Ship, Initial_Agreed_Delivery, Initial_Actual_Delivery, Initial_Requested_Quantity, Initial_Actual_Quantity 
    Init finalSht, i, Final_Firmed, Final_Agreed_Ship, Final_Actual_Ship, Final_Agreed_Delivery, Final_Actual_Delivery, Final_Requested_Quantity, Final_Actual_Quantity 

    'Initial Highlighting 
    CheckAndColor Initial_Firmed, Final_Firmed 
    CheckAndColor Initial_Agreed_Ship, Final_Agreed_Ship 
    CheckAndColor Initial_Actual_Ship, Final_Actual_Ship 
    CheckAndColor Initial_Agreed_Delivery, Final_Agreed_Delivery 
    CheckAndColor Initial_Actual_Delivery, Final_Actual_Delivery 
    CheckAndColor Initial_Requested_Quantity, Final_Requested_Quantity 
    CheckAndColor Initial_Actual_Quantity, Final_Actual_Quantity 
    CheckAndColor Initial_Requested_Quantity, Initial_Actual_Quantity 
    CheckAndColor Final_Requested_Quantity, Final_Actual_Quantity 

    'Metric Calculation 
    QMetric initialSht.Cells(i, 27), Initial_Actual_Quantity.Value, Initial_Requested_Quantity.Value 
    QMetric finalSht.Cells(i, 27), Final_Actual_Quantity.Value, Final_Requested_Quantity.Value 

    DMetric initialSht.Cells(i, 28), Initial_Agreed_Delivery_Date, Initial_Actual_Delivery_Date 
    DMetric finalSht.Cells(i, 28), Final_Agreed_Delivery_Date, Final_Actual_Delivery_Date 

    'Bulk Lead time 
    BulkLT = DateDiff("d", Now, Final_Agreed_Ship) 
    If IsEmpty(Final_Firmed) Then 
     If BulkLT < 90 Then Final_Firmed.Interior.Color = RGB(225, 225, 0) 
    End If 
End Sub 


Sub Init(sht As Worksheet, i As Long, Firmed As Range, Agreed_Ship As Range, Actual_Ship As Range, Agreed_Delivery As Range, Actual_Delivery As Range, Requested_Quantity As Range, Actual_Quantity As Range) 
    With sht 
     Set Firmed = .Cells(i, 9) 
     Set Agreed_Ship = .Cells(i, 10) 
     Set Actual_Ship = .Cells(i, 11) 
     Set Agreed_Delivery = .Cells(i, 13) 
     Set Actual_Delivery = .Cells(i, 14) 
     Set Requested_Quantity = .Cells(i, 15) 
     Set Actual_Quantity = .Cells(i, 16) 
    End With 
End Sub 


Sub CheckAndColor(rng1 As Range, rng2 As Range) 
    If Not (rng1 = rng2) Then rng1.Interior.Color = RGB(225, 225, 0) And rng2.Interior.Color = RGB(225, 225, 0) 
End Sub 


Sub QMetric(rng As Range, Actual_Quantity As Double, Requested_Quantity As Double) 
    Dim QMetric As Double 

    QMetric = (Actual_Quantity/Requested_Quantity) * 100 
    rng.Value = QMetric 
    If (QMetric < 90 Or QMetric > 110) Then rng.Interior.Color = RGB(225, 225, 0) 
End Sub 


Sub DMetric(rng As Range, Agreed_Delivery_Date As Date, Actual_Delivery_Date As Date) 
    Dim DMetric As Double 

    DMetric = DateDiff("d", Agreed_Delivery_Date, Actual_Delivery_Date) 
    rng.Value = DMetric 
    If (DMetric > 5 Or DMetric < -5) Then rng.Interior.Color = RGB(225, 225, 0) 
End Sub 

：

をあなたのコードで例えば

あなたが書いた：

Set Initial_Actual_Quantity = Cells(i, 16) 
... 
Set Final_Actual_Quantity = Cells(i, 15) 

を、私は列16は、両シートのために行うだろうと想定