三、Range对象（3）

6、单元格格式

1）Font：字体

Sub FontDemo()
'####根据实际需求，先批量设置通用样式
With Sheet1.UsedRange.Font
.Name = "微软雅黑" 'Name：字体名称
.Size = 12 'Size：字体大小
End With

'####个别样式单独设置
Sheet1.UsedRange.Rows(1).Font.Bold = True 'Bold：加粗
Sheet1.Range("A1:C1").Font.Italic = True 'Italic：斜体
Sheet1.Range("B1").Font.Italic = False '取消B1的斜体
With Sheet1.Range("D1:E1").Font
.Underline = xlUnderlineStyleSingle 'Underline：下划线
.Color = RGB(255, 0, 0) 'Color：颜色
End With
Sheet1.Range("D1:E1").Font.ColorIndex = 5 'ColorIndex：颜色

'####不常用的属性
Sheet1.Range("A1").Font.Strikethrough = True 'Strikethrough：添加删除线
Sheet1.Range("A1").Font.Superscript = True 'Superscript：上标
Sheet1.Range("A1").Font.Subscript = True 'Subscript：下标
'注意：上标和下标只能出现一个，上面代码下标在后，所有上标会被取消
End Sub

Underline对应表
—————————————————————-
常量 值 说明
xlUnderlineStyleNone -4142 无下划线
xlUnderlineStyleSingle 2 单下划线
xlUnderlineStyleDouble -4119 双下划线
xlUnderlineStyleSingleAccounting 4 会计用单下划线
xlUnderlineStyleDoubleAccounting 5 会计用双下划线
—————————————————————-
[常量]看是一大串，其实想记住很简单，前面是 xl + Underline + Style + 自己想要的样式。
常用 None 和 Single，或者直接 .Font.Underline = 2 也能设置单下划线

        设置颜色Color不清楚对应哪个RGB，可以在调色板看。步骤：随意选中一个单元格 → 选择想要的颜色 → 其他颜色。例如我想要的是下图的棕色，那么此时的 Color = RGB(191,143,0) 。

ColorIndex 几年前找到的一张对照表，少了 31 – 56 号。

2）Borders：边框

    Borders 是 Range 对象的一个属性，它本身是一个集合，包含了单元格区域的所有边框（上、下、左、右、内部横线、内部竖线、斜对角线）。

        3个核心属性：LineStyle、Weight、Color（ColorIndex）

Sub BordersDemo()
'清空Sheet1的所有边框
Sheet1.Cells.Borders.LineStyle = xlLineStyleNone
Sheet1.Cells.Borders(xlDiagonalDown).LineStyle = xlLineStyleNone
Sheet1.Cells.Borders(xlDiagonalUp).LineStyle = xlLineStyleNone

'####访问方式1：使用 Borders 索引访问特定边框（精准控制）
With Sheet1.Range("A1").Borders(xlEdgeLeft) '左边框
.LineStyle = xlContinuous '线条样式，实线
.Weight = xlThin '粗细，细
.Color = RGB(0, 0, 0) '黑色
End With
Sheet1.Range("A1:B2").Borders(xlEdgeTop).LineStyle = xlContinuous '上边框
Sheet1.Range("A1:B2").Borders(xlEdgeRight).LineStyle = xlContinuous '右边框
Sheet1.Range("A1:B2").Borders(xlEdgeBottom).LineStyle = xlContinuous '下边框
Sheet1.Range("D1:F10").Borders(xlInsideVertical).LineStyle = xlContinuous '内部竖线
Sheet1.Range("D1:F10").Borders(xlInsideHorizontal).LineStyle = xlContinuous '内部横线
Sheet1.Range("A1:B2").Borders(xlDiagonalDown).LineStyle = xlContinuous '从左上到右下的对角线
Sheet1.Range("A1:B2").Borders(xlDiagonalUp).LineStyle = xlContinuous '从左下到右上的对角线

'####访问方式2：除对角线外的所有边框（统一设置）
Sheet1.Range("H1:J4").Borders.LineStyle = xlDash '虚线
End Sub

——————- LineStyle 对照表 ——————-
常量 值 说明
xlEdgeLeft 7 左边框
xlEdgeRight 10 右边框
xlEdgeTop 8 上边框
xlEdgeBottom 9 下边框
xlInsideVertical11 内部竖线（多列时有效）
xlInsideHorizontal12 内部横线（多行时有效）
xlDiagonalDown 5 对角线（左上→右下），不常用
xlDiagonalUp 6 对角线（左下→右上），不常用
——————————————————–

——————– Weight 对照表 ———————
常量 值 说明
xlThin 2 细
xlHairline 1 极细（实际看起来和xlThin差不多）
xlMedium-4138 中等
xlThick 4 最粗
——————————————————–

        如果一个宏程序有多处地方需要加边框，可以封装为一个工具，重复调用

Sub BorderTest()
'清空Sheet1的所有边框
Sheet1.Cells.Borders.LineStyle = xlLineStyleNone
Sheet1.Cells.Borders(xlDiagonalDown).LineStyle = xlLineStyleNone
Sheet1.Cells.Borders(xlDiagonalUp).LineStyle = xlLineStyleNone

Call addCusBorder(Sheet1.Range("H2:J4"), xlDash, xlThin, "", _
xlInsideVertical, xlInsideHorizontal) '只添加内部虚线细边框
Call addCusBorder(Sheet1.Range("H2:J4"), "", xlThick, "", _
xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom) '只添加外部实线粗边框
Call addCusBorder(Sheet1.Range("M2:N4"), "", "", "") '不填bdrs，默认加除对角线外的所有边框
End Sub

Sub addCusBorder(cRng As Range, lStyle As Variant, _
lWeight As Variant, clr As Variant, ParamArray bdrs() As Variant)
'@param cRng: 要添加边框的单元格区域，必需
'@param lStyle: 线条样式，必需
'@param clr: 边框颜色，必需
'@param bdrs: 需要添加的边框，可选
If Trim(lStyle) = "" Then lStyle = xlContinuous '空值默认实线
If Trim(lWeight) = "" Then lWeight = xlThin '空值默认细
If Trim(clr) = "" Then clr = RGB(0, 0, 0) '空值默认黑色
If UBound(bdrs) = -1 Then '不填默认除对角线外所有边框
With cRng.Borders
.LineStyle = lStyle
.Weight = lWeight
.Color = clr
End With
Else
With cRng
For Each bdr In bdrs
.Borders(bdr).LineStyle = lStyle
.Borders(bdr).Weight = lWeight
.Borders(bdr).Color = clr
Next bdr
End With
End If
End Sub

3）Interior：背景色/填充

        Interior 是 Range 对象的一个属性，它本身也是一个对象，代表单元格的内部填充。功能如下图，图案填充应用场景不多，一般会结合条件搭配纯色背景使用，例如甘特图的排期和实际进度差异。

Sub InteriorDemo()
'####背景颜色
Sheet1.Range("A1").Interior.Color = RGB(255, 0, 0)
Sheet1.Range("B1").Interior.ColorIndex = 4

'####图案
'设置图案填充
With Sheet1.Range("C1").Interior
.Pattern = xlPatternHorizontal '水平条纹
.PatternColor = RGB(255, 255, 0) '条纹颜色为黄色
.ColorIndex = 1 '纯色背景为黑色。最终单元格填充为黑黄相间的条纹
End With

'纯色填充（最常用）。xlPatternSolid是默认项，上文的 A1 B1 都是 Pattern = xlPatternSolid
With Sheet1.Range("D1").Interior
.Pattern = xlPatternSolid
.Color = RGB(255, 0, 255)
End With
End Sub

        Interior 的 Color / ColorIndex 和实际颜色对照可参考 Font 。

——————- Pattern 对照表 ——————-
常量 值 效果
xlPatternNone -4142 无图案
xlPatternSolid 1 纯色（与Color搭配）
xlPatternGray75% 17 深灰色
xlPatternGray50% 18 中灰色
xlPatternGray25% 19 浅灰色
xlPatternHorizontal -4128 水平条纹
xlPatternVertical -4166 垂直条纹
xlPatternCross -4125 交叉网格
xlPatternDiagonalDown-4127 斜对角线（左下→右上）
xlPatternDiagonalUp -4126 斜对角线（左上→右下）
——————————————————

7、对齐方式

        HorizontalAlignment 设置水平方向， VerticalAlignment 设置垂直方向。

Sub AlignmentDemo()
'####水平方向
Sheet1.Range("A1").HorizontalAlignment = xlCenter
'####垂直方向
Sheet1.Range("A1").VerticalAlignment = xlCenter
End Sub

——————– HorizontalAlignment 对照表 ————————-
常量 值 效果
xlGeneral 1 常规（默认，文本左对齐，数字右对齐）
xlLeft -4131 左对齐
xlCenter -4108 居中
xlRight -4152 右对齐
xlFill 5 填充（内容重复填满单元格）
xlJustify -4130 两端对齐（多行时均匀分布）
xlCenterAcrossSelection 7 跨列居中（类似合并单元格效果，但不合并）
xlDistributed -4117 分散对齐（内容均匀分布在单元格中）
————————————————————————-

———————- VerticalAlignment对照表 ————————–
常量 值 效果
xlTop -4160 顶端对齐
xlCenter -4108 居中（垂直方向）
xlBottom -4107 底端对齐（默认）
xlJustify -4130 两端对齐（多行时均匀分布）
xlDistributed-4117 分散对齐（内容均匀分布在单元格中）
————————————————————————-

8、合并单元格

        MergeCells 可以用来判断圈中的区域是否有合并的单元格；

        Merge 合并单元格；

        UnMerge 取消合并。建议每次合并前先取消合并，再对选中的区域合并（新建的工作表除外）。

Sub MergeDemo()
'判断单元格是否被合并
If Sheet1.Range("A1").MergeCells Then
Sheet1.Range("A1").UnMerge '取消指定区域的合并
End If

Sheet1.Range("A1:C3").Merge '合并A1:C1
Sheet1.Range("A1").Value = "MergeTest"

'获取合并区域的行数和列数
With Sheet1.Range("A1").MergeArea
mRows = .Rows.Count
mCols = .Columns.Count
End With

'合并后，只保留了左上角单元格的值。需要通过 .MergeArea.Cells(1).Value 获取
c1 = Sheet1.Range("C1").Value
c2 = Sheet1.Range("C1").MergeArea.Cells(1).Value

MsgBox "合并了" & mRows & "行 x " & mCols & "列" & vbCrLf _
& "c1的值为 " & c1 & vbCrLf _
& "c2的值为 " & c2
'输出结果：3行 x 3列，c1是空值，c2 = "MergeTest"
End Sub

9、Address：地址引用

        Address 是 Range 对象的一个只读属性，返回单元格区域的地址引用（作为字符串）。借用上文 A1:C3 的合并。

完整语法：Range.Address(RowAbsolute, ColumnAbsolute, ReferenceStyle, External, RelativeTo
)。5个参数都是可选。默认返回绝对引用（带$号）。

Sub AddressDemo()
'#### RowAbsolute/ColumnAbsolute：行/列是否觉得引用。默认 True
aStr = Sheet1.Range("A1").Address '返回 $A$1
aStr = Sheet1.Range("A1").MergeArea.Address '$A$1:$C$3，等同于 Range("A1:C3").Address
aStr = Sheet1.Range("A1").Address(False) '$A1
aStr = Sheet1.Range("A1").Address(, False) 'A$1
aStr = Sheet1.Range("A1").Address(False, False) 'A1
'#### ReferenceStyle：引用样式。默认 xlA1
aStr = Sheet1.Range("A1").Address(, , xlA1) '$A$1
aStr = Sheet1.Range("B2").Address(ReferenceStyle:=xlR1C1) 'R2C2。R代表行，C代表列
'#### External：是否包含工作簿+工作表名称。默认 False
aStr = Sheet1.Range("A1").Address(External:=True) '[工作簿名]Sheet1!$A$1
aStr = Sheet1.Range("A1").Address(, , , False) '$A$1
'#### RelativeTo：相对引用的基准点。
'如果 RowAbsolute 和 ColumnAbsolute 为 False，且 ReferenceStyle 是 xlR1C1，则必须为相对引用包含一个起点。
aStr = Sheet1.Range("B2").Address(False, False, , , Sheet1.Range("C3")) '$B$2。
'基准点无效，因为 ReferenceStyle 是默认的 xlA1

'#### 完整写法如下。下一篇 公式R1C1会提到
'RC
aStr = Sheet1.Range("B2").Address( _
RowAbsolute:=False, ColumnAbsolute:=False, _
ReferenceStyle:=xlR1C1, External:=False, _
RelativeTo:=Sheet1.Range("B2"))
'R[1]C[1]
aStr = Sheet1.Range("B2").Address( _
RowAbsolute:=False, ColumnAbsolute:=False, _
ReferenceStyle:=xlR1C1, External:=False, _
RelativeTo:=Sheet1.Range("A1"))
'R[-3]C[-2]
aStr = Sheet1.Range("B2").Address( _
RowAbsolute:=False, ColumnAbsolute:=False, _
ReferenceStyle:=xlR1C1, External:=False, _
RelativeTo:=Sheet1.Range("D5"))
End Sub