问Exel VBA:运行时错误13类型不匹配

EN

   COLUMN A    COLUMNB             COLUMN C 
1  ADDRESS     Services(s) USED    VEHICLE(S) USED
2  Address1    Service1, Service3  Vehicle1, Vehicle3, Vehicle4  
3  Address2    Service1, Service4  Vehicle1, Vehicle3, Vehicle4
4  Address3    Service2, Service5  Vehicle1, Vehicle2, Vehicle5
5  Address4    Service2, Service3  Vehicle1, Vehicle6 
6  Address1    Service5, Service6  Vehicle2, Vehicle5, Vehicle6 
7  Address2    Service2, Service3  Vehicle2, Vehicle3
8  Address4    Service4, Service6  Vehicle1, Vehicle2, Vehicle3, Vehicle4, Vehicle5, Vehicle6   

   COLUMN A    COLUMN B            


4              Address1                                                                 

12             Service1
13             Service3
14             Service5
15             Service6
16
17

50             Vehicle1
51             Vehicle2
52             Vehicle3
53             Vehicle4
54             Vehicle5
56             Vehicle6

Private Sub Worksheet_Change(ByVal Target As Range)

' call Function only if modifed cell is in Column "B"
If Not IsError(Application.Match(Range("B4"), Worksheets("Google Data").Range("E1:E" & LastRow(Worksheets("Google Data"))), 0)) Then
    If Not Intersect(Target, Range("B4")) Is Nothing Then
        If (Target.Value <> "") Then
            Application.EnableEvents = False
            Call FilterAddress(Target.Value)
        Else
            On Error Resume Next
            MsgBox Target.Address & "Cell can't be blank, Input a value first."
            Err.Clear
            Exit Sub
        End If
    End If
Else
On Error Resume Next
    MsgBox "The Appointment # you entered is incorrect or does not exist. Please try again."
    Err.Clear
    Exit Sub
End If

Application.EnableEvents = True

End Sub

Option Explicit

Sub FilterAddress(FilterVal As String)


Dim LastRow As Long
Dim FilterRng As Range, cell As Range
Dim Dict As Object
'Dim ID
Dim Vehicle As Variant
Dim VehicleArr As Variant
Dim i As Long, j As Long
Dim Service As Variant
Dim ServiceArr As Variant
Dim x As Long, y As Long
Dim My_Range As Range

With Sheets("Sheet1")
    ' find last row with data in column "A" (Adress)
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    Set FilterRng = .Range("A1:C" & LastRow)

    .Range("A1").AutoFilter
    ' AutoFilter "Sheet1" according to value in "Sheet2" in Column B
    FilterRng.AutoFilter Field:=1, Criteria1:=FilterVal

    Set Dict = CreateObject("Scripting.Dictionary")

    ' create an array with size up to number of rows >> will resize it later
    ReDim ServiceArr(1 To LastRow)
    j = 1 ' init array counter

    For Each cell In .Range("B2:B" & LastRow).SpecialCells(xlCellTypeVisible)
        ' read values from cell to array using the Split function
        Service = Split(cell.Value, ",")

        For i = LBound(Service) To UBound(Service)
            Service(i) = Trim(Service(i)) ' remove extra spaces from string

            If Not Dict.exists(Service(i)) Then
                Dict.Add Service(i), Service(i)

                ' save Service Name to array >> will use it later for "Bubble-sort" and paste in "Sheet2"
                ServiceArr(j) = Service(i)
                j = j + 1 ' increment ServiceArr counter
            End If
        Next i

    Next cell
    ' resize array up to number of actual Service
    ReDim Preserve ServiceArr(1 To j - 1)

End With

Dim ServiceTmp As Variant
' Bubble-sort Service Array >> sorts the Service array from smallest to largest
For i = 1 To UBound(ServiceArr) - 1
    For j = i + 1 To UBound(ServiceArr)
        If ServiceArr(j) < ServiceArr(i) Then
            ServiceTmp = ServiceArr(j)
            ServiceArr(j) = ServiceArr(i)
            ServiceArr(i) = ServiceTmp
        End If
    Next j
Next i

' now the "fun" part >> paste to "Sheet2"
With Sheets("Sheet2")
    .Range("A1").Value = "ADDRESS"
    .Range("B4").Value = FilterVal
    .Range("C1").Value = "VEHICLE(S) USED"

    ' clear contents from previous run

    .Range("B12:B17").ClearContents
    .Range("B12:B" & UBound(ServiceArr) + 11) = WorksheetFunction.Transpose(ServiceArr)

End With

FilterRng.Parent.AutoFilterMode = False

With Sheets("Sheet1")
    ' find last row with data in column "A" (Adress)
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

    Set FilterRng = .Range("A1:C" & LastRow)

    .Range("A1").AutoFilter
    ' AutoFilter "Sheet1" according to value in "Sheet2" in Column B
    FilterRng.AutoFilter Field:=1, Criteria1:=FilterVal

    Set Dict = CreateObject("Scripting.Dictionary")

    ' create an array with size up to number of rows >> will resize it later
    ReDim VehicleArr(1 To LastRow)
    y = 1 ' init array counter

    For Each cell In .Range("C2:C" & LastRow).SpecialCells(xlCellTypeVisible)
        ' read values from cell to array using the Split function
        Vehicle = Split(cell.Value, ",")

        For x = LBound(Vehicle) To UBound(Vehicle)
            Vehicle(x) = Trim(Vehicle(x)) ' remove extra spaces from string

            If Not Dict.exists(Vehicle(x)) Then
                Dict.Add Vehicle(x), Vehicle(x)

                ' save Vehicle Name to array >> will use it later for "Bubble-sort" and paste in "Sheet2"
                VehicleArr(y) = Vehicle(x)
                y = y + 1 ' increment VehicleArr counter
            End If
        Next x

    Next cell
    ' resize array up to number of actual Vehicle
    ReDim Preserve VehicleArr(1 To y - 1)

End With

Dim VehicleTmp As Variant
' Bubble-sort Vehicle Array >> sorts the Vehicle array from smallest to largest
For x = 1 To UBound(VehicleArr) - 1
    For y = x + 1 To UBound(VehicleArr)
        If VehicleArr(y) < VehicleArr(x) Then
            VehicleTmp = VehicleArr(y)
            VehicleArr(y) = VehicleArr(x)
            VehicleArr(x) = VehicleTmp
        End If
    Next y
Next x

' now the "fun" part >> paste to "Sheet2"
With Sheets("Sheet2")
    .Range("A1").Value = "ADDRESS"
    .Range("B4").Value = FilterVal
    .Range("C1").Value = "VEHICLE(S) USED"

    ' clear contents from previous run

    .Range("B50:B55").ClearContents
    .Range("B50:B" & UBound(VehicleArr) + 49) = WorksheetFunction.Transpose(VehicleArr)

End With

FilterRng.Parent.AutoFilterMode = False
End Sub

 Call FilterAddress(Target.Value)