老师们，代码运行不了，帮忙优化一下

happy1117

老师们，帮忙优化代码让它运行

Sub 日期比较()
    Dim Ar(), R As Long, D
    D = Worksheets("Sheet1").Range("h1").Value        （这里要怎么改呢,现在提示下标越界)
    R = Range("B65536").End(xlUp).Row
    ReDim Ar(1 To R, 1)
    Ar = Range("B2:B" & R)
    For i = 1 To UBound(Ar)
        R = Abs(DateDiff("M", D, Ar(i, 1)))
        Select Case R
            Case 0 To 2
                Ar(i, 1) = "3个月以内"
            Case 3 To 5
                Ar(i, 1) = "4-6个月"
            Case 6 To 8
                Ar(i, 1) = "7-9个月"
            Case 9 To 11
                Ar(i, 1) = "10-12个月"
            Case Else
                Ar(i, 1) = "一年以上"
        End Select
    Next
    Columns("D").Insert
    Range("D2").Resize(UBound(Ar)) = Ar
End Sub

5201314

1. Sub 日期比较()
   
2. Dim Ar(), R As Long, D
   
3. D = Worksheets("HAT").Range("h1").Value
   
4. R = Range("B65536").End(xlUp).Row
   
5. ReDim Ar(1 To R, 1)
   
6. Ar = Range("B2:B" & R)
   
7. For i = 1 To UBound(Ar)
   
8. R = Abs(DateDiff("M", D, Ar(i, 1)))
   
9. Select Case R
   
10. Case 0 To 2
    
11. Ar(i, 1) = "3个月以内"
    
12. Case 3 To 5
    
13. Ar(i, 1) = "4-6个月"
    
14. Case 6 To 8
    
15. Ar(i, 1) = "7-9个月"
    
16. Case 9 To 11
    
17. Ar(i, 1) = "10-12个月"
    
18. Case Else
    
19. Ar(i, 1) = "一年以上"
    
20. End Select
    
21. Next
    
22. Columns("D").Insert
    
23. Range("D2").Resize(UBound(Ar)) = Ar
    
24. End Sub
    
25. 
    

复制代码

happy1117

5201314 发表于 2013-4-1 23:48

这下可以了，学习了~

5201314

happy1117 发表于 2013-4-1 23:53
这下可以了，学习了~

如果解决了，请评个最佳。谢谢