[已解决]求各位大师如何才能不用 on error resume next

michen

上清宫主 说不可乱用， on error resume next ,现在就求各位，告诉我如何 在不用 on error resume next 情况下
让程序执行下去。

最佳答案

月排行榜 / 总排行榜

上清宫主

2013-11-22 13:01

就爱惹事
改的，看成不？
Sub ditlast()
    Dim Ar1()
    Set d = CreateObject("scripting.dictionary")
    With Sheet5
        LastRow = .Range("A65536").End(xlUp).Row
        Ar1 = .Range("A2:B" & LastRow)
    End With
    For i = 1 To UBound(Ar1)
        If Not d.Exists(Ar1(i, 1)) Then d(Ar1(i, 1)) = Ar1(i, 2)    '如果没有重复的，if  …… then可省，直接赋值就成了
    Next
    With Sheet3
        LastRow2 = .Range("A65536").End(xlUp).Row
        Ar1 = .Range([H2], "H" & LastRow2)
    End With
    For i = 1 To UBound(Ar1)
       s$ = ""
        For Each tmp In Split(Ar1(i, 1), "-")
            If d.Exists(tmp) Then s = s & "  " & d(tmp)
        Next
        Ar1(i, 1) = Mid(s, 2)
    Next i
    Sheet3.[Q2].Resize(UBound(Ar1), 1) = Ar1
End Sub

跳转到最佳答案楼层

上清宫主

就爱惹事
改的，看成不？
Sub ditlast()
    Dim Ar1()
    Set d = CreateObject("scripting.dictionary")
    With Sheet5
        LastRow = .Range("A65536").End(xlUp).Row
        Ar1 = .Range("A2:B" & LastRow)
    End With
    For i = 1 To UBound(Ar1)
        If Not d.Exists(Ar1(i, 1)) Then d(Ar1(i, 1)) = Ar1(i, 2)    '如果没有重复的，if  …… then可省，直接赋值就成了
    Next
    With Sheet3
        LastRow2 = .Range("A65536").End(xlUp).Row
        Ar1 = .Range([H2], "H" & LastRow2)
    End With
    For i = 1 To UBound(Ar1)
       s$ = ""
        For Each tmp In Split(Ar1(i, 1), "-")
            If d.Exists(tmp) Then s = s & "  " & d(tmp)
        Next
        Ar1(i, 1) = Mid(s, 2)
    Next i
    Sheet3.[Q2].Resize(UBound(Ar1), 1) = Ar1
End Sub

michen

上官大人，怎么变成这么简单了，我要回家研究 6个小时，才能懂。

hwc2ycy

会用的人就能用好，不会的人用就属于乱用了。

michen

我终于自己找到如何不用on error resume next 的方法了。注意红色字体。估计是当时忽略了数组从0开始
Sub ditlast()
    Application.Volatile
    On Error Resume Next
   
   
    Dim answer As String
    Dim a As String
    Dim Arr11, LastRow, LastRow2, Arr, Arr1
    Dim Arr21(), Arr22()
    Set d = CreateObject("scripting.dictionary")
    Set d1 = CreateObject("scripting.dictionary")
    With Sheet5
        LastRow = .Range("A65536").End(xlUp).Row
        Rem lastrow 的值为 2001 sheet2
              
        
   
        Arr11 = .Range("A2:B" & LastRow)
              Rem MsgBox UBound(Arr11) 2000 下届为1
              
                  
        
        
    End With
    For i = 1 To UBound(Arr11)
        If Not d.Exists(Arr11(i, 1)) Then
            n = n + 1
            d(Arr11(i, 1)) = n
            ReDim Preserve Arr21(1 To 2, 1 To n)
            Arr21(1, n) = Arr11(i, 1)
            Arr21(2, n) = Arr11(i, 2)
        End If
    Next
Rem n的值为2000 是字典对的 个数。sheet2
  Rem 以上产生了一个不重复的数组 Ar21 上面是航班号，下面是承运人，不重复数组已经搞定。
  
  Rem Arr21 留着以后用 是一个第一行是航班号，第二行是承运人的两行表。且删除了重复。
  
   


   
Rem 下面到了数据源层面
    With Sheet3
        LastRow2 = .Range("A65536").End(xlUp).Row
       Rem MsgBox LastRow2 求值为1001 sheet
      
        
        
        Arr = .Range([H2], "H" & LastRow2)
      Rem  MsgBox LBound(Arr)
      
        
        Rem Ubound(Arr) 一维 数组上届为 1000 下届 为1
        
    End With
   
   ReDim Arr22(1 To UBound(Arr) + 1, 1 To 1)
    Rem 把已经定义好的字典定义成与数据源相同的高度且保留值
   
    Rem Arr 为实际数据源的1维数组
   
    For i = 1 To UBound(Arr) + 1
    Rem 遍历数据源 1 to 1000 数据源重要
   
   
        Arr1 = Split(Arr(i, 1), "-")
        Rem 将数据源每行分割后给数组 Arr1
        
        
        
        
               
        For j = 0 To UBound(Arr1)
        If Arr21(2, d(Arr1(j))) <> "" Then
                     
        
            cy = Arr21(2, d(Arr1(j)))
            Rem 由于字典的值是列数所以根据航班号可以返回字典的值也就是列数 所以cy已经返回承运人了
         Rem Debug.Print cy
         
            
           Rem If Not d1.Exists(cy) Then
                answer = answer + Arr21(2, d(Arr1(j))) & " "
           Rem    n1 = n1 + 1
           Rem  d1(cy) = n1
              
               
               
              
               
             End If
            
        Next j
        
      
        Rem n1 为被分割的航班号在能在字典中能查到的不重复的个数。
        Rem 如果n1 即航班号出现过那么 字典肯定就不能在输入键了
        Rem 这样巧妙的删除了重复
        
        
        
        
        
        
      
        Arr22(i, 1) = answer
        
        answer = ""
      
              
        n1 = 0
        d1.RemoveAll
    Next i
   
   
   
    Sheet3.[Q2].Resize(UBound(Arr22), 1) = Arr22
End Sub