四、Range操作
4.2取得最后一個非空單元格
xlDown/xlToRight/xlToLeft/xlUp
Dim ERow as Long
Erow=Range("A" & Rows.Count).End(xlUp).Row
1
2
4.3 復制單元格區域
注意：使用PasteSpecial方法時指定xlPasteAll（粘貼全部），並不包括粘貼列寬
Sub CopyWithSameColumnWidths()
Sheets("Sheet1").Range("A1").CurrentRegion.Copy
With Sheets("Sheet2").Range("A1")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteAll
End With
Application.CutCopyMode = False
End Sub
Sheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteValues '粘貼數值
1
2
3
4
5
6
7
8
9
4.9 設置字符格式
4.9.1設置單元格文本字符串格式
Sub CellCharacter()
With Range("A1")
.Clear
.Value = "Y=X2+1"
.Characters(4, 1).Font.Superscript = True '將第4個字符設置為上標
.Characters(1, 1).Font.ColorIndex = 3
.Font.Size = 20
End With
End Sub
1
2
3
4
5
6
7
8
9
通過Range對象的Characters屬性來操作指定的字符。
Characters屬性返回一個Characters對象，代表對象文字的字符區域。Characters屬性的語法格式如下
Characters(Start, Length)
1
4.9.2 設置圖形對象文本字符格式
如下示例為A3單元格批注添加指定文本，並設置字符格式。
Sub ShapeCharacter()
If Range("A3").Comment Is Nothing Then
Range("A3").AddComment Text:=""
End If
With Range("A3").Comment
.Text Text:="Microsoft Excel 2016"
.Shape.TextFrame.Characters(17).Font.ColorIndex = 3'返回從第17個字符開始到最后一個字符的字符串
End With
End Sub
1
2
3
4
5
6
7
8
9
TextFrame屬性返回Shape對象的文本框對象，而Characters屬性返回其中的文本字符。
4.10 單元格區域添加邊框
使用Range對象的Borders集合可以快速地對單元格區域全部邊框應用相同的格式。
Range對象的BorderAround方法可以快速地為單元格區域添加外邊框。
Sub AddBorders()
Dim rngCell As Range
Set rngCell = Range("B2:F8")
With rngCell.Borders
.LineStyle = xlContinuous '邊框線條的樣式
.Weight = xlThin '設置邊框線條粗細
.ColorIndex = 5 '設置邊框線條顏色
End With
rngCell.BorderAround xlContinuous, xlMedium, 5 '添加一個加粗外邊框
Set rngCell = Nothing
End Sub
1
2
3
4
5
6
7
8
9
10
11
[外鏈圖片轉存失敗,源站可能有防盜鏈機制,建議將圖片保存下來直接上傳(img-RKKb9Tpw-1581860892362)(C:\Users\admin\AppData\Roaming\Typora\typora-user-images\image-20200206164323610.png)]
在單元格區域中應用多種邊框格式
Sub BordersIndexDemo()
Dim rngCell As Range
Set rngCell = Range("B2:F8")
With rngCell.Borders(xlInsideHorizontal) '內部水平
.LineStyle = xlDot
.Weight = xlThin
.ColorIndex = 5
End With
With rngCell.Borders(xlInsideVertical) '內部垂直
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
rngCell.BorderAround xlContinuous, xlMedium, 5
Set rngCell = Nothing
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Borders(index)屬性返回單個Border對象，其參數index取值可為以下：
名稱 值 說明
xlDiagonalDown 5 從區域中每個單元格的左上角到右下角的邊框。
xlDiagonalUp 6 從區域中每個單元格的左下角到右上角的邊框。
xlEdgeBottom 9 區域底部的邊框。
xlEdgeLeft 7 區域左邊緣的邊框。
xlEdgeRight 10 區域右邊緣的邊框。
xlEdgeTop 8 區域頂部的邊框。
xlInsideHorizontal 12 區域中所有單元格的水平邊框（區域以外的邊框除外）。
xlInsideVertical 11 區域中所有單元格的垂直邊框（區域以外的邊框除外）。
去除邊框
Sub Restore()
Columns("B:F").Borders.LineStyle = xlNone
End Sub
1
2
3
4.11 高亮顯示單元格區域
高亮顯示是指以某種方式突出顯示活動單元格或指定的單元格區域，使得用戶可以一目了然地獲取某些信息。
1.高亮顯示單個單元格
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = xlNone'清除所有單元格的內部填充顏色
Target.Interior.ColorIndex = 5
End Sub
1
2
3
4
[外鏈圖片轉存失敗,源站可能有防盜鏈機制,建議將圖片保存下來直接上傳(img-eHyHtUS6-1581860892364)(C:\Users\admin\AppData\Roaming\Typora\typora-user-images\image-20200206165636905.png)]
2.高亮顯示行列
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngHighLight As Range
Dim rngCell1 As Range, rngCell2 As Range
Cells.Interior.ColorIndex = xlNone
Set rngCell1 = Intersect(ActiveCell.EntireColumn, _
[HighLightArea])
Set rngCell2 = Intersect(ActiveCell.EntireRow, [HighLightArea])
On Error Resume Next
Set rngHighLight = Application.Union(rngCell1, rngCell2)
rngHighLight.Interior.ThemeColor = 9
Set rngCell1 = Nothing
Set rngCell2 = Nothing
Set rngHighLight = Nothing
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
命名區域HighLightArea(示例文件已指定B2:H15單元格區域)
[外鏈圖片轉存失敗,源站可能有防盜鏈機制,建議將圖片保存下來直接上傳(img-fRfa5MXB-1581860892364)(C:\Users\admin\AppData\Roaming\Typora\typora-user-images\image-20200206165756300.png)]
3.結合條件格式定義名稱高亮顯示行
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ThisWorkbook.Names.Add "ActRow", ActiveCell.Row
End Sub
1
2
3
[外鏈圖片轉存失敗,源站可能有防盜鏈機制,建議將圖片保存下來直接上傳(img-cd7d2naO-1581860892364)(C:\Users\admin\AppData\Roaming\Typora\typora-user-images\image-20200206165917049.png)]
4.結合條件格式定義名稱高亮顯示行列
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ThisWorkbook.Names.Add "ActRow", ActiveCell.Row
ThisWorkbook.Names.Add "ActCol", ActiveCell.Column
End Sub
1
2
3
4
[外鏈圖片轉存失敗,源站可能有防盜鏈機制,建議將圖片保存下來直接上傳(img-2ghE6bHB-1581860892365)(C:\Users\admin\AppData\Roaming\Typora\typora-user-images\image-20200206170134713.png)]
4.12 動態設置單元格數據驗證序列
【數據驗證】對話框如下圖
[外鏈圖片轉存失敗,源站可能有防盜鏈機制,建議將圖片保存下來直接上傳(img-N9c3qcNx-1581860892365)(C:\Users\admin\AppData\Roaming\Typora\typora-user-images\image-20200206171335869.png)]
如下示例代碼通過VBA將示例工作簿中工作表“Office 2016"以外的工作表名稱設置為工作表“Office 2016"中C3單元格的數據驗證序列。
數據驗證序列是由逗號分隔的字符串，兩個逗號之間的空字符串將被忽略。
Sub SheetsNameValidation()
Dim i As Integer
Dim strList As String
Dim wksSht As Worksheet
For Each wksSht In Worksheets
If wksSht.Name <> "Office 2016" Then
strList = strList & wksSht.Name & ","
End If
Next wksSht
With Worksheets("Office 2016").Range("C3").Validation
.Delete
.Add Type:=xlValidateList, Formula1:=strList
End With
Set wksSht = Nothing
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub DeleteValidation()
Range("C3").Validation.Delete
End Sub
1
2
3
[外鏈圖片轉存失敗,源站可能有防盜鏈機制,建議將圖片保存下來直接上傳(img-0hG4eDXy-1581860892365)(C:\Users\admin\AppData\Roaming\Typora\typora-user-images\image-20200206171703131.png)]
Validation對象的Add方法向指定區域內添加數據驗證，其語法格式如下：
Add (Type, AlertStyle, Operator, Formula1, Formula2)
1
參數Type是必需的，代表數據驗證類型。其值可為以下常量之一：
名稱 值 說明
xlValidateCustom 7 使用任意公式驗證數據有效性。
xlValidateDate 4 日期值。
xlValidateDecimal 2 數值。
xlValidateInputOnly 0 僅在用戶更改值時進行驗證。
xlValidateList 3 值必須存在於指定列表中。
xlValidateTextLength 6 文本長度。
xlValidateTime 5 時間值。
xlValidateWholeNumber 1 全部數值。
參數Formula2指定數據驗證公式的第二部分。僅當Operator為xlBetween或xlNotBetween時有效。
4.14 判斷單元格公式是否存在錯誤
Excel公式返回的結果可能是一個錯誤的文本，包含#NULL、#DIV/0!、#VALUE！、#REF！、#NAME?、#NUM！和#N/A等。
通過判斷Range對象中的Value屬性的返回結果是否為錯誤值，可得知公式是否存在錯誤。
Sub FormulaIsError()
If VBA.IsError(Range("A1").Value) = True Then
MsgBox "A1單元格錯誤類型為:" & Range("A1").Text
Else
MsgBox "A1單元格公式結果為:" & Range("A1").Value
End If
End Sub
1
2
3
4
5
6
7
IsError函數判斷表達式是否為一個錯誤值，如果是則返回邏輯值True，否則返回邏輯值False。
4.15批量刪除所有錯誤值
使用CurrentRegion屬性取得包含A1單元格的當前區域。
Sub DeleteError()
Dim rngRange As Range
Dim rngCell As Range
Set rngRange = Range("a1").CurrentRegion
For Each rngCell In rngRange
If VBA.IsError(rngCell.Value) = True Then
rngCell.Value = ""
End If
Next rngCell
Set rngCell = Nothing
Set rngRange = Nothing
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
通過定位功能可獲取錯誤值的單元格對象，並批量修改。
利用單元格對象的SpecialCells方法定位所有錯誤值。
Sub DeleteAllError()
On Error Resume Next
Dim rngRange As Range
Set rngRange = Range("a1").CurrentRegion.SpecialCells _
(xlCellTypeConstants, xlErrors)
If Not rngRange Is Nothing Then
rngRange.Value = ""
End If
Set rngRange = Nothing
End Sub
1
2
3
4
5
6
7
8
9
10
單元格對象的SpecialCells方法返回一個Range對象，該對象代表與指定類型和值匹配的所有單元格，其語法格式如下：
SpecialCells(Type,Value)
1
參數與Type是必需的，用於指定定位類型，可為如下表列舉的XlCellType常量之一。
常量 值 說明
xlCellTypeAllFormatConditions -4172 任何格式的單元格
xlCellTypeAllValidation -4174 含有驗證條件的單元格
xlCellTypeBlanks 4 空單元格
xlCellTypeComments -4144 含有注釋的單元格
xlCellTypeConstants 2 含有常量的單元格
xlCellTypeFormulas -4123 含有公式的單元格
xlCellTypeLastCell 11 已用區域中的最后一個單元格
xlCellTypeSameFormatConditions -4173 具有相同的格式的單元格
xlCellTypeSameValidation -4175 驗證條件相同的單元格
xlCellTypeVisible 12 所有可見單元格
如果參數Type為xlCellTypeConstants或xlCellTypeFormulas，則該參數可用於確定結果中應包含哪幾類單元格，參數Value可為以下列舉的XlSpecialCellsValue常量之一。將這些值相加可使此方法返回多種類型的單元格。默認情況下，將選擇所有常量或公式，無論類型如何。
常量 值 說明
xlErrors 16 有錯誤的單元格。
xlLogical 4 具有邏輯值的單元格。
xlNumbers 1 具有數值的單元格。
xlTextValues 2 具有文本的單元格。
4.17 判斷單元格是否存在批注
Function blnComment(ByVal rngRange As Range) As Boolean
If rngRange.Cells(1).Comment Is Nothing Then
blnComment = False
Else
blnComment = True
End If
End Function
1
2
3
4
5
6
7
返回單元格區域rngRange的第一個單元格是否存在批注。
注：對於合並單元格的批注，批注對象從屬於合並單元格的第一個單元格。
Range對象的Comment屬性返回批注對象，如果指定的單元格不存在批注，則該屬性返回Nothing。
4.18 為單元格添加批注
Sub Comment_Add()
With Range("B5")
If .Comment Is Nothing Then
.AddComment Text:=.Text
.Comment.Visible = True
End If
End With
End Sub
1
2
3
4
5
6
7
8
使用Range對象的AddComment方法為單元格添加批注。
編輯批注文本
使用批注對象的Text方法，能夠獲取或修改單元格批注的文本。
Sub Comment_Add()
With Range("B5")
If .Comment Is Nothing Then
.AddComment Text:=.Text
.Comment.Visible = True
End If
End With
End Sub
1
2
3
4
5
6
7
8
Comment對象的Text方法的語法格式如下。
Text(Text,Start,Overwrite)
1
參數Text代表需要添加的文本。
參數Start指定添加文本的起始位置。
參數OrverWrite指定是否覆蓋現有文本。默認值為False(新文字插入現有文字中)。
vbCrLf常量代表回車換行符。
4.21 顯示圖片批注
為單元格批注添加背景圖片或將圖片作為批注的內容
Sub ChangeCommentShapeType()
With Range("B3").Comment
.Shape.Fill.UserPicture _
ThisWorkbook.Path & "\Logo.jpg"
End With
End Sub
1
2
3
4
5
6
Comment對象的Shape屬性返回批注對象的圖形對象
Fill屬性能夠返回FillFormat對象，該對象包括指定的圖表或圖形的填充格式屬性，UserPicture方法為圖形填充圖像
4.22 設置批注字體
單元格批注的字體通過單元格批注的Shape對象中文本框對象(TextFrame)的字符對象(Characters)進行設置。TextFrame代表Shape對象中的文本框，包含文本框中的文字。
Sub CommentFont()
Dim objComment As Comment
For Each objComment In ActiveSheet.Comments
With objComment.Shape.TextFrame.Characters.Font
.Name = "微軟雅黑"
.Bold = msoFalse
.Size = 14
.ColorIndex = 3
End With
Next objComment
Set objComment = Nothing
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
4.23 快速判斷單元格區域是否存在合並單元格
Range對象的MergeCells屬性可以判斷單元格區域是否包含合並單元格，如果該屬性返回值為True，則表示區域包含合並單元格。
Sub IsMergeCell()
If Range("A1").MergeCells = True Then
MsgBox "包含合並單元格"
Else
MsgBox "沒有包含合並單元格"
End If
End Sub
1
2
3
4
5
6
7
對於單個單元格，直接通過MergeCells屬性判斷是否包含合並單元格。
Sub IsMerge()
If VBA.IsNull(Range("A1:E10").MergeCells) = True Then
MsgBox "包含合並單元格"
Else
MsgBox "沒有包含合並單元格"
End If
End Sub
1
2
3
4
5
6
7
當單元格區域中同時包含合並單元格和非合並單元格時，MergeCells屬性將返回Null.
4.24合並單元格時連接每個單元格內容
在合並多個單元格時，將各個單元格的內容連接起來保存在合並后的單元格區域中。
Sub MergeValue()
Dim strText As String
Dim rngCell As Range
If TypeName(Selection) = "Range" Then
For Each rngCell In Selection
strText = strText & rngCell.Value
Next rngCell
Application.DisplayAlerts = False
Selection.Merge
Selection.Value = strText
Application.DisplayAlerts = True
End If
Set rngCell = Nothing
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
使用TypeName函數判斷當前選定對象是否為Range對象。
將DisplayAlerts屬性設置為False，禁止Excel彈出警告對話框。
4.25 取消合並時在每個單元格中保留內容
Sub UnMergeValue()
Dim strText As String
Dim i As Long, intCount As Integer
For i = 2 To Range("B1").End(xlDown).Row
With Cells(i, 1)
strText = .Value
intCount = .MergeArea.Count
.UnMerge
.Resize(intCount, 1).Value = strText
End With
i = i + intCount - 1
Next i
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
4.26 合並內容相同的單列連續單元格
Sub BackUp()
Dim intRow As Integer, i As Long
Application.DisplayAlerts = False
With ActiveSheet
intRow = .Range("A1").End(xlDown).Row
For i = intRow To 2 Step -1
If .Cells(i, 1).Value = .Cells(i - 1, 1).Value Then
.Range(.Cells(i - 1, 1), .Cells(i, 1)).Merge
End If
Next i
End With
Application.DisplayAlerts = True
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
使用For循環結構從最后一行開始，向上逐個判斷相鄰單元格內容的內容是否相同，如果相同則合並單元格區域。
————————————————
版權聲明：本文為CSDN博主「snail一路向前」的原創文章，遵循CC 4.0 BY-SA版權協議，轉載請附上原文出處鏈接及本聲明。
原文鏈接：https://blog.csdn.net/qq389445046/article/details/104349650