|
本帖最后由 hert25 于 2017-11-10 23:29 编辑
本人学习到这一课以后,发现,里面讲解的数组方法是存在逻辑不严谨会导致出错之处,因我也是新手,这一课我消化了三天才改好代码,不知兰老师为什么不在这里更改一下代码,后学之人也就不用犯错了,发这个代码是为了让新手少走些跟我一样的弯路,省些时间学习,向兰老师致敬,您的付出是我等后学之人的明灯.三种数组方法时间差不多,可能是数据太少的原因吧,但三种思路却是学习的好材料.
代码如下
Sub 数组方法1()
Dim arr, t
Dim x As Integer
Dim sr As String, sr1 As String
t = Timer
Range("a:d").Interior.ColorIndex = xlNone
arr = Range("d2:d" & Range("d1").End(4).Row)
For x = 1 To UBound(arr)
If arr(x, 1) > 500 Then
sr1 = sr
sr = sr & "A" & x + 1 & ":D" & x + 1 & ","
If Len(sr) > 255 Then
sr = sr1
Range(Left(sr, Len(sr) - 1)).Interior.ColorIndex = 4
sr = "A" & x + 1 & ":D" & x + 1 & ","
End If
End If
Next x
Range(Left(sr, Len(sr) - 1)).Interior.ColorIndex = 4
MsgBox Timer - t
End Sub
Sub 数组方法2()
t = Timer
Dim arr
Dim x%, x1%
Dim sr As String, sr1 As String
Range("a:d").Interior.ColorIndex = xlNone
arr = Range("d2:d" & Range("d1").End(4).Row)
For x = 1 To UBound(arr)
If arr(x, 1) > 500 Then
sr1 = sr
x1 = x + 1
Do
x = x + 1
If x = UBound(arr) + 1 Then
Exit Do
End If
Loop Until arr(x, 1) <= 500
sr = sr & "A" & x1 & ":D" & x & ","
If Len(sr) > 255 Then
sr = sr1
Range(Left(sr, Len(sr) - 1)).Interior.ColorIndex = 4
sr = "A" & x1 & ":D" & x & ","
End If
End If
Next x
Range(Left(sr, Len(sr) - 1)).Interior.ColorIndex = 4
MsgBox Timer - t
End Sub
Sub 数组方法3()
t = Timer
Dim arr
Dim x%, x1%
Dim sr As String, sr1 As String
Range("a:d").Interior.ColorIndex = xlNone
arr = Range("d2:d" & Range("d1").End(4).Row)
For x = 1 To UBound(arr)
If arr(x, 1) > 500 Then
sr1 = sr
x1 = x + 1
Do
x = x + 1
If x = UBound(arr) + 1 Then
Exit Do
End If
Loop Until arr(x, 1) <= 500
sr = sr & "A" & x1 & ":D" & x & ","
If Len(sr) > 255 Then
sr = sr1
Application.Intersect(Range("a:d"), Range(Left(sr, Len(sr) - 1))).Interior.ColorIndex = 4
sr = "A" & x1 & ":D" & x & ","
End If
End If
Next x
Application.Intersect(Range("a:d"), Range(Left(sr, Len(sr) - 1))).Interior.ColorIndex = 4
MsgBox Timer - t
End Sub
|
|