通過(guò)不同的方式獲取對(duì)Excel工作表單元格區(qū)域的引用后,在VBA中引用這些對(duì)象即可獲取單元格區(qū)域的各種信息,。
目錄
1 用Address屬性獲取單元格地址
2 獲取區(qū)域的行列信息
3 用HasFormula屬性統(tǒng)計(jì)區(qū)域中公式數(shù)量
4 追蹤公式單元格
5 用ColorIndex屬性按顏色統(tǒng)計(jì)單元格數(shù)量
1 用Address屬性獲取單元格地址
Sub 當(dāng)前單元格地址()
Dim rng1 As Range
Dim str1 As String, strTitle As String
Set rng1 = ActiveCell
strTitle = '當(dāng)前單元格地址'
str1 = '絕對(duì)地址:' & rng1.Address & vbCrLf
str1 = str1 & '行的絕對(duì)地址:' & rng1.Address(RowAbsolute:=False) & vbCrLf
str1 = str1 & '列的絕對(duì)地址:' & rng1.Address(ColumnAbsolute:=False) & vbCrLf
str1 = str1 & '以R1C1形式顯示:' & rng1.Address(ReferenceStyle:=xlR1C1) & vbCrLf
str1 = str1 & '相對(duì)地址:' & rng1.Address(False, False)
MsgBox prompt:=str1, Title:=strTitle
End Sub
2 獲取區(qū)域的行列信息
Sub 當(dāng)前區(qū)域信息()
Dim rng1 As Range, str1 As String
Set rng1 = ActiveCell.CurrentRegion
str1 = '當(dāng)前區(qū)域信息:' & vbNewLine
str1 = str1 & '單元格數(shù)量:' & rng1.Cells.Count & vbNewLine
str1 = str1 & '行數(shù):' & rng1.Rows.Count & vbNewLine
str1 = str1 & '列數(shù):' & rng1.Columns.Count & vbNewLine
str1 = str1 & '表頭行數(shù):' & rng1.ListHeaderRows
MsgBox str1, vbOKOnly, '當(dāng)前區(qū)域信息'
Set rng1 = Nothing
End Sub
3 用HasFormula屬性統(tǒng)計(jì)區(qū)域中公式數(shù)量
Sub 當(dāng)前區(qū)域公式數(shù)量()
Dim c1 As Range, rng1 As Range
Dim i As Integer
Set rng1 = ActiveCell.CurrentRegion
For Each c1 In rng1.Cells
If c1.HasFormula Then
i = i + 1
End If
Next
If i > 0 Then
MsgBox '當(dāng)前單元格所在區(qū)域共有 ' & i & ' 個(gè)公式,。'
Else
MsgBox '當(dāng)前單元格所在區(qū)域沒(méi)有公式。'
End If
End Sub
4 追蹤公式單元格
主要反映的是公式所在單元格與公式引用單元格的關(guān)系,。
Sub 追蹤引用單元格()
ActiveCell.ShowPrecedents
End Sub
Sub 追蹤從屬單元格()
ActiveCell.ShowDependents
End Sub
上面過(guò)程執(zhí)行完成后,,如果存在引用或從屬關(guān)系,則會(huì)在單元格之間出現(xiàn)一條藍(lán)線,。
5 用ColorIndex屬性按顏色統(tǒng)計(jì)單元格數(shù)量
Sub 按顏色統(tǒng)計(jì)單元格()
Dim rng As Range, rng1 As Range
Dim i As Integer, Arr(1 To 56) As Integer, k As Integer
Set rng = ActiveSheet.UsedRange '獲取使用區(qū)域
For Each rng1 In rng '循環(huán)處理區(qū)域中的每個(gè)單元格
k = rng1.Interior.ColorIndex '獲取填充色
If k <> xlColorIndexNone Then '具有底色
Arr(k) = Arr(k) + 1 '對(duì)應(yīng)顏色數(shù)組中進(jìn)行累加
End If
Next
i = 8 '統(tǒng)計(jì)單元格顯示的位置
For k = 1 To 56
If Arr(k) <> 0 Then
Cells(i, 1).Interior.ColorIndex = k
Cells(i, 2) = Arr(k)
i = i + 1
End If
Next
End Sub
-End-