他山之石——VBA数组的使用-Part4（VBA Array）

最新推荐文章于 2024-05-04 14:08:23 发布

预见未来to50

最新推荐文章于 2024-05-04 14:08:23 发布

阅读量1.0k

点赞数 1

分类专栏： Excel技巧及VBA编程（Excel_VBA）

本文链接：https://blog.csdn.net/hpdlzu80100/article/details/80788682

版权

Excel技巧及VBA编程（Excel_VBA）专栏收录该内容

404 篇文章 169 订阅

订阅专栏

学到这个程度，已经具有一定程度的实用性了。事实上，单元格设置背景颜色在实际工作中用到过，不过是帮同事完成的。记得当时花了近四个小时辛苦调试出来的。用到了三重循环，用到了单元格内换行的判断等比较复杂的逻辑。

Option Explicit
'数组也可以设置格式？
   '数组除了数字类型外，当然没有颜色、字体等格式，但是别忘了range对象可以表示多个连续或不连续的单元格区域
   '利用上述特点，我们就是要数组构造单元格地址串，然后批量对单元格进行格式设置。
   '注意，单元格地址串不能>255，所以如果单元格操作过多，我们还需要分次分批设置单元格格式
   
Sub 填充颜色()
 Range("a2:d2,a7:d7,a10:d10").Interior.ColorIndex = 3
End Sub

Option Explicit

Sub 单元格循环()
 Dim x As Integer
 Dim t
 清除颜色
 t = Timer
 For x = 2 To Range("a65536").End(xlUp).Row
   If Range("d" & x) > 500 Then
     Range(Cells(x, 1), Cells(x, 4)).Interior.ColorIndex = 3
   End If
 Next x
 MsgBox Timer - t
End Sub

Sub 清除颜色()
 Range("a:d").Interior.ColorIndex = xlNone
End Sub

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 = 3
   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 = 3
        sr = ""
      End If
   End If
 Next x
 MsgBox Timer - t
End Sub
Sub 数组方法2()
Dim arr, t
 Dim x As Integer, x1 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) Then Range(Left(sr, Len(sr) - 1)).Interior.ColorIndex = 3
   If arr(x, 1) > 500 Then
      sr1 = sr
      x1 = x + 1
      Do
        x = x + 1
      Loop Until arr(x, 1) <= 500
      
      sr = sr & "A" & x1 & ":D" & x & ","
      If Len(sr) > 255 Then
        sr = sr1
        x = x1 - 1
        Range(Left(sr, Len(sr) - 1)).Interior.ColorIndex = 3
        sr = ""
      End If
      x = x - 1
   End If
 Next x
 MsgBox Timer - t


End Sub
Sub 数组方法3()
Dim arr, t
 Dim x As Integer, x1 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) Then Application.Intersect(Range("a:d"), Range(Left(sr, Len(sr) - 1))).Interior.ColorIndex = 3
   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 = 3
        sr = ""
      End If
      x = x - 1
   End If
 Next x
 MsgBox Timer - t
End Sub