[發問] (已解決)執行程式後跳出視窗?

candy516

各位前輩您好~
我用了之前Hsieh前輩幫我寫的程式篩選資料，之前都還可以用!
但現在用都會跳出一些奇怪的東西，請問有沒有人可以幫我解答一下呢?先謝謝各位前輩!^^
(因檔案太大，我先將01~09年資料刪除了，只剩2010年!)

程式碼如下

1. Sub ex()
   
2. On Error Resume Next
   
3. Dim A As Range, B As Range, B1 As Range, B2 As Range, C As Range, Rng As Range, Rng1 As Range, d As Object
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Set sht = Sheets.Add(after:=Sheets(1))
   
6. Application.ScreenUpdating = False
   
7. With Sheet1
   
8.    For Each A In .Range(.[A2], .[A65536].End(xlUp))
   
9.       mystr = A & "," & Left(A.Offset(, 1), 4)
   
10.      '你Sheet1的A欄是以日期格式yyyy/m/d輸入，但格式設成yyyymmdd，所以，造成非全部為8碼
    
11.    '用TEXT屬性得到所見字串
    
12.       d(mystr) = DateValue(Format(A.Offset(, 1).Text, "0000/00/00"))
    
13.       If Err.Number <> 0 Then MsgBox A & A.Offset(, 1)
    
14.    Next
    
15. End With
    
16. k = 1: r = 1
    
17. For Each ky In d.keys
    
18. y = Split(ky, ",")(1)
    
19. With Sheets(y)
    
20. Set C = .Columns("A").Find(d(ky))
    
21. Set B = .Rows(1).Find(Split(ky, ",")(0))
    
22. If Not C Is Nothing And Not B Is Nothing Then
    
23. x = Application.Max(3, C.Row - 14)
    
24.    Set Rng = .Cells(x, 1).Resize(15, 1)
    
25.    Set Rng1 = .Cells(x, B.Column).Resize(15, 1)
    
26.    With sht
    
27.       Rng.Copy .Cells(r, k)
    
28.       Rng1.Copy .Cells(r, k + 1)
    
29.       .Cells(r, 3) = y & "年第" & B.Column - 1 & "筆"
    
30.    End With
    
31.    r = r + 15
    
32.    Else
    
33.    MsgBox "無此除權資料"
    
34. End If
    
35. End With
    
36. Next
    
37. Application.ScreenUpdating = True
    
38. End Sub

複製代碼

mark15jill

回復 1# candy516

你有動到一些程式碼嗎???
因為就我剛剛把你的程式碼丟去乾淨EXCEL檔案內 就發現 好多紅字...
           mystr = A "," & Left(A.Offset(, 1), 4)
      If Err.Number <> 0 Then MsgBox A A.Offset(, 1)
      .Cells(r, 3) = y "年第" & B.Column - 1 & "筆"


紅通通..

candy516

回復 2# mark15jill


    你好~
我重貼一次程式碼囉!^^

candy516

各位前輩，我找出問題了!= =
是有一年某一筆資料有誤，所以導致後面都跑不出來!
謝謝你們唷!^^