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

字数 1051阅读 91

数组也可以设置格式么?

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

推荐阅读更多精彩内容