Excel VBA Range cell operation example

Four, Range operation

4.2 get the last non-empty cell

xlDown/xlToRight/xlToLeft/xlUp

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

4.3 Copy cell range

Note: Specifies xlPasteAll (all paste) using PasteSpecial method, the column width is not paste comprising

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 Formatting characters

4.9.1 Set cell format the text string

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

Operated by the specified character Characters Range object attributes.

Characters Characters property returns an object that represents the object literal character area. Characters attribute syntax is as follows

Characters(Start, Length)

4.9.2 set the character format text graphic objects

Cell A3 as exemplified specified text annotations are added, and set the character format.

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

Shape object TextFrame property returns text box object, and returns the text characters Characters property therein.

4.10 range of cells to add a border

Using the Range object Borders collection can quickly apply borders to a range of cells all the same format.

BorderAround Range object method can quickly add the external borders to a range of cells.

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

[Pictures of foreign chains dump fails, the source station may have a security chain mechanism, it is recommended to save the picture down directly upload (img-RKKb9Tpw-1581860892362) (C: \ Users \ admin \ AppData \ Roaming \ Typora \ typora-user-images \ image-20200206164323610.png)]

Border formatting in a variety of applications in a range of cells

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 property returns a single object whose index parameter value may be the following:

name	value	Explanation
xlDiagonalDown	5	Region from the upper left corner to the lower right corner of each cell frame.
xlDiagonalUp	6	From the lower left corner of each cell in the area to the upper right corner of the bezel.
xlEdgeBottom	9	Border on the bottom of the area.
xlEdgeLeft	7	The left edge of the border area.
xlEdgeRight	10	The right edge of the border area.
xlEdgeTop	8	Border area at the top.
xlInsideHorizontal	12	Horizontal border regions of all the cells (except the frame other than the region).
xlInsideVertical	11	Vertical border regions of all the cells (except the frame other than the region).

The removal of border

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

4.11 highlight a range of cells

Highlighting means to highlight in some manner designated active cell or range of cells, such that a user may access certain information at a glance.

1. Highlight a single cell

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

[Picture dump outside the chain fails, the source station may have a security chain mechanism, it is recommended to save the pictures uploaded directly down (img-eHyHtUS6-1581860892364) (C: \ Users \ admin \ AppData \ Roaming \ Typora \ typora-user-images \ image-20200206165636905.png)]

2. Highlight the ranks

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

Named area HighLightArea (example file is specified B2: H15 range of cells)

[Pictures of foreign chains dump fails, the source station may have a security chain mechanism, it is recommended to save the picture down directly upload (img-fRfa5MXB-1581860892364) (C: \ Users \ admin \ AppData \ Roaming \ Typora \ typora-user-images \ image-20200206165756300.png)]

3. Binding conditions format definition name is highlighted line

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ThisWorkbook.Names.Add "ActRow", ActiveCell.Row
End Sub

[Pictures of foreign chains dump fails, the source station may have a security chain mechanism, it is recommended to save the picture down directly upload (img-cd7d2naO-1581860892364) (C: \ Users \ admin \ AppData \ Roaming \ Typora \ typora-user-images \ image-20200206165917049.png)]

4. The binding conditions format definition name is highlighted ranks

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ThisWorkbook.Names.Add "ActRow", ActiveCell.Row
    ThisWorkbook.Names.Add "ActCol", ActiveCell.Column
End Sub

[Pictures of foreign chains dump fails, the source station may have a security chain mechanism, it is recommended to save the picture down directly upload (img-2ghE6bHB-1581860892365) (C: \ Users \ admin \ AppData \ Roaming \ Typora \ typora-user-images \ image-20200206170134713.png)]

4.12 dynamically set cell data verify sequence

[] Data Validation dialog below

[Pictures of foreign chains dump fails, the source station may have a security chain mechanism, it is recommended to save the picture down directly upload (img-N9c3qcNx-1581860892365) (C: \ Users \ admin \ AppData \ Roaming \ Typora \ typora-user-images \ image-20200206171335869.png)]

The sample code VBA worksheet by working examples other than the workbook "Office 2016" name to a worksheet "Office 2016" in cell C3 authentication sequence data.

Data validation sequences are separated by commas in the string, the empty string between two commas is ignored.

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

[Pictures of foreign chains dump fails, the source station may have a security chain mechanism, it is recommended to save the picture down directly upload (img-0hG4eDXy-1581860892365) (C: \ Users \ admin \ AppData \ Roaming \ Typora \ typora-user-images \ image-20200206171703131.png)]

Add Method Validation object to add authentication data into the designated area, syntax is as follows:

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

Type parameter is required, data representing the type of authentication. The value can be one of the following constants:

name	value	Explanation
xlValidateCustom	7	Use any formula to verify the validity of the data.
xlValidateDate	4	Date value.
xlValidateDecimal	2	Value.
xlValidateInputOnly	0	Only validated when the user changes the value.
xlValidateList	3	Value must exist in the specified list.
xlValidateTextLength	6	Text length.
xlValidateTime	5	Time value.
xlValidateWholeNumber	1	All values.

Formula2 parameter specifies the second portion of the data validation formula. Operator is valid only when xlBetween or xlNotBetween.

4.14 judging whether there is an error cell formula

Excel formula returns the result may be a false text contains # NULL, # DIV / 0!, # VALUE! , # REF! , # NAME?, # NUM! And # N / A and the like.

Analyzing results returned Value Range object attribute is an error value, a formula that if there are errors.

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 function to determine whether an expression is an error value, if it is a logical value True is returned, otherwise it returns a logical value False.

4.15 Batch delete all error values

Use CurrentRegion attribute acquiring current region containing cell 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

Cell object can be obtained by locating error function value, and bulk edit.

Using the method of cell object SpecialCells locate all error values.

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 method of cell object returns a Range object that represents all the cells specified type and value matching syntax is as follows:

SpecialCells(Type,Value)

Type parameter is required to specify the type of positioning, one can XlCellType constants listed in the following table.

constant	value	Explanation
xlCellTypeAllFormatConditions	-4172	Any format cells
xlCellTypeAllValidation	-4174	Cells containing the validation criteria
xlCellTypeBlanks	4	Empty cells
xlCellTypeComments	-4144	A cell containing a comment
xlCellTypeConstants	2	A cell containing a constant
xlCellTypeFormulas	-4123	A cell containing a formula
xlCellTypeLastCell	11	Used last cell area
xlCellTypeSameFormatConditions	-4173	It has the same format cell
xlCellTypeSameValidation	-4175	Same verify condition cell
xlCellTypeVisible	12	All the visible cells

If the parameter is xlCellTypeConstants or xlCellTypeFormulas Type, this parameter may be used to determine which results will include several types of cells, may be one of the following parameters Value listed XlSpecialCellsValue constant. These values ​​are added in this method can return a plurality of types of cells. By default, it will select all constants or formulas, regardless of the type.

constant	value	Explanation
xlErrors	16	Faulty cells.
xlLogical	4	Having a logic value of the cell.
xlNumbers	1	It has a value of the cell.
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

返回单元格区域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循环结构从最后一行开始，向上逐个判断相邻单元格内容的内容是否相同，如果相同则合并单元格区域。