数组也可以设置格式么?
数组除了数字类型外,当然没有颜色,字体等格式,但是range对象可以表示多个连接或者不连接的区域。利用这个特点,我们就是要数组构造单元格地址串,然后批量对单元格进行格式设置。注意的地方是,单元格的地址串不能大于255,如果单元格操作过多,我们还需要分次分批设置单元格格式。
根据一个sheet的产品数量单价金额,如果金额大于五百,则将当前行填充为绿色。
第一种方法单元格填充
Sub 单元格填充()
Dim x As Integer
For x = 2 To Range("d65535").End(xlUp).row
If Range("d" & x) > 500 Then
Range(Cells(x, 1), Cells(x, 4)).Interior.ColorIndex = 5
End If
Next x
End Sub
第二种方法数组填充
2.1 符合条件的每一行的单元格地址构成一个数组,对数组进行操作。
Sub 数组方法()
Dim arr, t
Dim x As Integer
Dim sr As String, sr1 As String
t = Timer
arr = Range("d2:d" & Range("a65536").End(xlUp).row)
For x = 1 To UBound(arr)
If x = UBound(arr) and sr <> "" Then Range(Left(sr, Len(sr) - 1)).Interior.ColorIndex = 4 '这是对单元格最后一批的填充,如果地址串大于255,则无法进行操作,这是进行一次判断,如果运行到最后,并且SR 不为空,则对区域进行颜色填充。
If arr(x, 1) > 500 Then
sr1 = sr
sr = sr & "A" & x + 1 & ":D" & x + 1 & "," ‘sr是个不断增加的单元格地址串,最后是一个逗号
If Len(sr) > 255 Then
sr = sr1 ‘重新让sr等于sr1,sr1是在连接之前的地址串
Range(Left(sr, Len(sr) - 1)).Interior.ColorIndex = 4 '把sr最后的那个逗号去掉,否则系统会提示出错
sr = ""
End If
End If
Next x
End Sub
2.2 有一些连续的单元格都符合条件,将符合条件的单元格地址合并,减少字符串的数量。
如A15:D15,A16:D16,A17:D17,A18:D18,地址可以简写为A15:D18
Sub 数组方法2()
Dim arr, t
Dim x As Integer, x1 As Integer
arr = Range("d2:d" & Range("a65536").End(xlUp).row)
For x = 1 To UBound(arr)
If x = UBound(arr) Then Range(Left(sr, Len(sr) - 1)).Interior.ColorIndex = 6
If arr(x, 1) > 500 Then
sr1 = sr
x1 = x + 1 ‘恢复的时候能用上,实际的行和数组的行正好差1
Do
x = x + 1
Loop Until arr(x, 1) <= 500 '在第15行,发现值大于500,接着循环,16行循环,大于500,17行大于500, 18行大于500,直到第19行,arr的值小于500,循环停止。
sr = sr & "A" & x1 & ":D" & x & ","
If Len(sr) > 255 Then
sr = sr1
x = x1 - 1 ’为什么需要减1, 因为上面的DO循环中,不论是否符合条件,x都要加1
Range(Left(sr, Len(sr) - 1)).Interior.ColorIndex = 5
sr = ""
End If
x = x - 1 'do 循环引起的, x 还需要减一
End If
Next x
End Sub
2.3 更加简化字符串地址长度,如将A15:D18简写为15:18,占用的字符串更少,所以在一个255的字符串长度限制中包括更多的单元格。
交集的方法:第二行到第七行与第一列到第四列的交集,即可满足填充条件
Sub 数组方法3()
Dim arr
Dim x As Integer, x1 As Integer
Dim sr As String, sr1 As String
arr = Range("d2:d" & Range("a65536").End(xlUp).row)
For x = 1 To UBound(arr)
If x = UBound(arr) Then Application.Intersect(Range("a:d"), Range(Left(sr, Len(sr) - 1))).Interior.ColorIndex = 7
If arr(x, 1) > 500 Then
sr1 = sr
x1 = x + 1
Do
x = x + 1
Loop Until arr(x, 1) <= 500
sr = sr & x1 & ":" & x & ","
If Len(sr) > 255 Then
sr = sr1
x = x1 - 1
Application.Intersect(Range("a:d"), Range(Left(sr, Len(sr) - 1))).Interior.ColorIndex = 8
sr = ""
End If
x = x - 1
End If
Next x
End Sub