Excel 运行时错误“13”：类型不匹配代码问题

Question

我正在处理此代码并不断出错。它将全部编译，但我不断收到运行时错误。我正在尝试比较两个不同的工作表，然后突出显示不匹配的单元格。我不确定错误发生在哪里。任何帮助将不胜感激。

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

至于最后一个错误，您将Initial_PO 作为值类型（Dim Initial_PO As Double）变暗，然后尝试将其设置为object（Set Initial_PO = Cells(i, 7)）：您选择一个类型（值或对象），然后一致地采取行动

此外，您可以通过引用范围和避免 Select() 方法和 Selection 属性来更好地控制代码并减少其执行时间

最后你复制了很多代码，这也可能导致不需要的拼写错误和松散的代码控制

对于以上所有内容，您可能需要考虑以下代码：

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 列对两张纸都适用