Excel VBA Range单元格操作实例

Excel VBA实例 专栏收录该内容
26 篇文章 2 订阅

四、Range操作

4.2取得最后一个非空单元格

xlDown/xlToRight/xlToLeft/xlUp

Dim ERow as Long
Erow=Range("A" & Rows.Count).End(xlUp).Row

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 '粘贴数值

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

通过Range对象的Characters属性来操作指定的字符。

Characters属性返回一个Characters对象,代表对象文字的字符区域。Characters属性的语法格式如下

Characters(Start, Length)

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

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

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(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

Borders(index)属性返回单个Border对象,其参数index取值可为以下:

名称说明
xlDiagonalDown5从区域中每个单元格的左上角到右下角的边框。
xlDiagonalUp6从区域中每个单元格的左下角到右上角的边框。
xlEdgeBottom9区域底部的边框。
xlEdgeLeft7区域左边缘的边框。
xlEdgeRight10区域右边缘的边框。
xlEdgeTop8区域顶部的边框。
xlInsideHorizontal12区域中所有单元格的水平边框(区域以外的边框除外)。
xlInsideVertical11区域中所有单元格的垂直边框(区域以外的边框除外)。

去除边框

Sub Restore()
    Columns("B:F").Borders.LineStyle = xlNone
End Sub

4.11 高亮显示单元格区域

高亮显示是指以某种方式突出显示活动单元格或指定的单元格区域,使得用户可以一目了然地获取某些信息。

1.高亮显示单个单元格

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Cells.Interior.ColorIndex = xlNone'清除所有单元格的内部填充颜色
    Target.Interior.ColorIndex = 5
End Sub

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(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

命名区域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

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(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

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(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
Sub DeleteValidation()
    Range("C3").Validation.Delete
End Sub

[外链图片转存失败,源站可能有防盗链机制,建议将图片保存下来直接上传(img-0hG4eDXy-1581860892365)(C:\Users\admin\AppData\Roaming\Typora\typora-user-images\image-20200206171703131.png)]

Validation对象的Add方法向指定区域内添加数据验证,其语法格式如下:

Add (Type, AlertStyle, Operator, Formula1, Formula2)

参数Type是必需的,代表数据验证类型。其值可为以下常量之一:

名称说明
xlValidateCustom7使用任意公式验证数据有效性。
xlValidateDate4日期值。
xlValidateDecimal2数值。
xlValidateInputOnly0仅在用户更改值时进行验证。
xlValidateList3值必须存在于指定列表中。
xlValidateTextLength6文本长度。
xlValidateTime5时间值。
xlValidateWholeNumber1全部数值。

参数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

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

通过定位功能可获取错误值的单元格对象,并批量修改。

利用单元格对象的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

单元格对象的SpecialCells方法返回一个Range对象,该对象代表与指定类型和值匹配的所有单元格,其语法格式如下:

SpecialCells(Type,Value)

参数与Type是必需的,用于指定定位类型,可为如下表列举的XlCellType常量之一。

常量说明
xlCellTypeAllFormatConditions-4172任何格式的单元格
xlCellTypeAllValidation-4174含有验证条件的单元格
xlCellTypeBlanks4空单元格
xlCellTypeComments-4144含有注释的单元格
xlCellTypeConstants2含有常量的单元格
xlCellTypeFormulas-4123含有公式的单元格
xlCellTypeLastCell11已用区域中的最后一个单元格
xlCellTypeSameFormatConditions-4173具有相同的格式的单元格
xlCellTypeSameValidation-4175验证条件相同的单元格
xlCellTypeVisible12所有可见单元格

如果参数Type为xlCellTypeConstants或xlCellTypeFormulas,则该参数可用于确定结果中应包含哪几类单元格,参数Value可为以下列举的XlSpecialCellsValue常量之一。将这些值相加可使此方法返回多种类型的单元格。默认情况下,将选择所有常量或公式,无论类型如何。

常量说明
xlErrors16有错误的单元格。
xlLogical4具有逻辑值的单元格。
xlNumbers1具有数值的单元格。
xlTextValues2具有文本的单元格。

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

返回单元格区域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

使用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

Comment对象的Text方法的语法格式如下。

Text(Text,Start,Overwrite)

参数Text代表需要添加的文本。

参数Start指定添加文本的起始位置。

参数OrverWrite指定是否覆盖现有文本。默认值为False(新文字插入现有文字中)。

vbCrLf常量代表回车换行符。

4.21 显示图片批注

为单元格批注添加背景图片或将图片作为批注的内容

Sub ChangeCommentShapeType()
    With Range("B3").Comment
        .Shape.Fill.UserPicture _
            ThisWorkbook.Path & "\Logo.jpg"
    End With
End Sub

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

4.23 快速判断单元格区域是否存在合并单元格

Range对象的MergeCells属性可以判断单元格区域是否包含合并单元格,如果该属性返回值为True,则表示区域包含合并单元格。

Sub IsMergeCell()
    If Range("A1").MergeCells = True Then
        MsgBox "包含合并单元格"
    Else
        MsgBox "没有包含合并单元格"
    End If
End Sub

对于单个单元格,直接通过MergeCells属性判断是否包含合并单元格。

Sub IsMerge()
    If VBA.IsNull(Range("A1:E10").MergeCells) = True Then
        MsgBox "包含合并单元格"
    Else
        MsgBox "没有包含合并单元格"
    End If
End Sub

当单元格区域中同时包含合并单元格和非合并单元格时,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

使用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

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

使用For循环结构从最后一行开始,向上逐个判断相邻单元格内容的内容是否相同,如果相同则合并单元格区域。

  • 3
    点赞
  • 0
    评论
  • 29
    收藏
  • 一键三连
    一键三连
  • 扫一扫,分享海报

©️2021 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值