二十四讲 数组与单元格格式

数组也可以设置格式么？

数组除了数字类型外，当然没有颜色，字体等格式，但是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