1,066
社区成员
发帖
与我相关
我的任务
分享vb运行错误 ：实时错误 13 类型不匹配
求大哥帮忙看一下是咋回事
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
...全文
请发表友善的回复…
发表回复
