vb运行错误：实时错误 13 类型不匹配

2022-08-01 16:22:57 730 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

VB数据库操作与SQL练习指南本博客提供多个VB数据库操作练习，涵盖数据绑定、DataGridView控件设置、事件处理、LINQ查询、异常处理及SQL语句编写等内容。通过实际案例指导读者完成数据库连接、记录增删改查、数据显示与排序等任务，帮助掌握VB与Access数据库交互的核心技能。阅读详情

求大哥帮忙看一下是咋回事

Sub Sorting()
Application.DisplayAlerts = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Dim T: T = Time
Dim WF As Object: Set WF = Application.WorksheetFunction
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Sht As Worksheet: Set Sht = Wb.Worksheets("退件总表")
Dim Sht_Sorting As Worksheet: Set Sht_Sorting = Wb.Worksheets("品名分类规则")
Dim Returns: Set Returns = Sht.Cells.Find("退件原因")
Dim Declare_name: Set Declare_name = Sht.Cells.Find("申报中文名称")
Dim Goods_Name: Set Goods_Name = Sht.Cells.Find("品名分类")
Dim Type_Name: Set Type_Name = Sht.Cells.Find("侵权/违禁品类型")
Dim RTN&: RTN = Returns.Column
Dim Declares&: Declares = Declare_name.Column
Dim Name&: Name = Goods_Name.Column
Dim Types&: Types = Type_Name.Column
Dim Arr: Arr = Sht.Cells(1, 1).CurrentRegion
Dim Sht_Sorting_Arr: Sht_Sorting_Arr = Sht_Sorting.Cells(1, 1).CurrentRegion
Dim MaxRow&: MaxRow = Sht.Cells(Rows.Count, 1).End(xlUp).Row
Dim Sht_Sorting_MaxRow&: Sht_Sorting_MaxRow = Sht_Sorting.Cells(Rows.Count, 1).End(xlUp).Row
Dim Dict_Name: Set Dict_Name = CreateObject("Scripting.Dictionary")

For i = 2 To Sht_Sorting_MaxRow
If Not Dict_Name.Exists(Sht_Sorting_Arr(i, 1)) Then Dict_Name.Add Sht_Sorting_Arr(i, 1), Array(Sht_Sorting_Arr(i, 2), Sht_Sorting_Arr(i, 3))
Next

With Sht
For i = MaxRow To 2 Step -1
Select Case True
Case InStr(Arr(i, RTN), "侵权") Or InStr(Arr(i, RTN), "其他") Or InStr(Arr(i, RTN), "客户退") Or InStr(Arr(i, RTN), "申报") Or InStr(Arr(i, RTN), "超时退") Or InStr(Arr(i, RTN), "低报") Or InStr(Arr(i, RTN), "包装不符") Or InStr(Arr(i, RTN), "未到") Or InStr(Arr(i, RTN), "值过高") Or InStr(Arr(i, RTN), "价重比退回") Or InStr(Arr(i, RTN), "数量超多") Or InStr(Arr(i, RTN), "高货值") Or InStr(Arr(i, RTN), "材积重")
For Each Key In Dict_Name.Keys
If InStr(Arr(i, Declares), Key) Then .Cells(i, Name) = Dict_Name(Key)(0): Exit For
Next
If InStr(Arr(i, RTN), "侵权") Then .Cells(i, Types) = "侵权" Else .Cells(i, Types) = "其他"
Case InStr(Arr(i, RTN), "走带电") Or InStr(Arr(i, RTN), "渠道普货") Or InStr(Arr(i, RTN), "包装不合格") Or InStr(Arr(i, RTN), "普货带电") Or InStr(Arr(i, RTN), "普货发带电") Or InStr(Arr(i, RTN), "带电物品") Or InStr(Arr(i, RTN), "渠道带电") Or InStr(Arr(i, RTN), "普货走带电") Or InStr(Arr(i, RTN), "超容量")
For Each Key In Dict_Name.Keys
If InStr(Arr(i, Declares), Key) Then .Cells(i, Name) = Dict_Name(Key)(0): .Cells(i, Types) = Dict_Name(Key)(1): Exit For
Next
Case Else
For Each Key In Dict_Name.Keys
If InStr(Arr(i, RTN), Key) Then .Cells(i, Name) = Dict_Name(Key)(0): .Cells(i, Types) = Dict_Name(Key)(1): Exit For
Next
End Select
Next
End With

Application.DisplayAlerts = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "共" & Format(Time - T, "s") & "秒"
End Sub
Sub Sorting_Fast()
Application.DisplayAlerts = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Dim T: T = Time
Dim WF As Object: Set WF = Application.WorksheetFunction
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Sht As Worksheet: Set Sht = Wb.Worksheets("退件总表")
Dim Sht_Sorting As Worksheet: Set Sht_Sorting = Wb.Worksheets("品名分类规则")
Dim Returns: Set Returns = Sht.Cells.Find("退件原因")
Dim Declare_name: Set Declare_name = Sht.Cells.Find("申报中文名称")
Dim Goods_Name: Set Goods_Name = Sht.Cells.Find("品名分类")
Dim Type_Name: Set Type_Name = Sht.Cells.Find("侵权/违禁品类型")
Dim RTN&: RTN = Returns.Column
Dim Declares&: Declares = Declare_name.Column
Dim Name&: Name = Goods_Name.Column
Dim Types&: Types = Type_Name.Column
Dim Arr: Arr = Sht.Cells(1, 1).CurrentRegion
Dim Sht_Sorting_Arr: Sht_Sorting_Arr = Sht_Sorting.Cells(1, 1).CurrentRegion
Dim MaxRow&: MaxRow = Sht.Cells(Rows.Count, 1).End(xlUp).Row
Dim Sht_Sorting_MaxRow&: Sht_Sorting_MaxRow = Sht_Sorting.Cells(Rows.Count, 1).End(xlUp).Row
Dim Dict_Name: Set Dict_Name = CreateObject("Scripting.Dictionary")

For i = 2 To Sht_Sorting_MaxRow
If Not Dict_Name.Exists(Sht_Sorting_Arr(i, 1)) Then Dict_Name.Add Sht_Sorting_Arr(i, 1), Array(Sht_Sorting_Arr(i, 2), Sht_Sorting_Arr(i, 3))
Next

With Sht
For i = MaxRow To 2 Step -1
If IsEmpty(Arr(i, Name)) Or IsEmpty(Arr(i, Types)) Then
Select Case True
Case InStr(Arr(i, RTN), "侵权") Or InStr(Arr(i, RTN), "其他") Or InStr(Arr(i, RTN), "客户退") Or InStr(Arr(i, RTN), "申报") Or InStr(Arr(i, RTN), "超时退") Or InStr(Arr(i, RTN), "低报") Or InStr(Arr(i, RTN), "包装不符") Or InStr(Arr(i, RTN), "未到") Or InStr(Arr(i, RTN), "值过高") Or InStr(Arr(i, RTN), "价重比退回") Or InStr(Arr(i, RTN), "数量超多") Or InStr(Arr(i, RTN), "高货值") Or InStr(Arr(i, RTN), "材积重")
For Each Key In Dict_Name.Keys
If InStr(Arr(i, Declares), Key) Then 这里错误实时错误 13 类型不匹配.Cells(i, Name) = Dict_Name(Key)(0): Exit For
Next
If InStr(Arr(i, RTN), "侵权") Then .Cells(i, Types) = "侵权" Else .Cells(i, Types) = "其他"
Case InStr(Arr(i, RTN), "走带电") Or InStr(Arr(i, RTN), "渠道普货") Or InStr(Arr(i, RTN), "包装不合格") Or InStr(Arr(i, RTN), "普货带电") Or InStr(Arr(i, RTN), "普货发带电") Or InStr(Arr(i, RTN), "带电物品") Or InStr(Arr(i, RTN), "渠道带电") Or InStr(Arr(i, RTN), "普货走带电") Or InStr(Arr(i, RTN), "超容量")
For Each Key In Dict_Name.Keys
If InStr(Arr(i, Declares), Key) Then .Cells(i, Name) = Dict_Name(Key)(0): .Cells(i, Types) = Dict_Name(Key)(1): Exit For
Next
Case Else
For Each Key In Dict_Name.Keys
If InStr(Arr(i, RTN), Key) Then .Cells(i, Name) = Dict_Name(Key)(0): .Cells(i, Types) = Dict_Name(Key)(1): Exit For
Next
End Select
End If
Next
End With

Application.DisplayAlerts = True: Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "共" & Format(Time - T, "s") & "秒"
End Sub