excel VBA自动设置表格格式

通过VBA自动将表格格式快速设置为要求的格式，减少手工调整的时间。这个程序还有部份功能未实现，在数字列中文字右对齐，数字添加千位分隔符，强调的行添加背景色等内容。
原始表格格式如下：

设置格式后格式如下：

打印预览：

具体VBA代码如下：

Option Explicit


Sub 设置表格格式()
'
'自动设置表格格式的宏
'
'

    '关闭屏幕刷新
    Application.ScreenUpdating = False
    
    '如果第一行不为空，插入一行空行
    If Not WorksheetFunction.CountA(Rows(1)) = 0 Then
        Cells(1, 1).EntireRow.Insert shift:=xlShiftDown
    End If
    '如果第一列不为空，插入一列空列
    If Not WorksheetFunction.CountA(Columns("A")) = 0 Then
        Cells(1, 1).EntireColumn.Insert shift:=xlShiftToRight
    End If
    
    Cells.Select
    With Selection.Font
        .Name = "微软雅黑"       '设置字体为微软雅黑
        .Size = 11               '设置字号为11
    End With
    Selection.RowHeight = Selection.Font.Size * 1.6     '设置行高为字号的1.6倍
    '消除已设置的边框
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    '取得最后一个非空单元格行号列号
    Dim maxR As Integer
    Dim maxC As Integer
    'Debug.Print ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Count).Address
    'Debug.Print ActiveSheet.UsedRange.Columns.Count
    maxR = ActiveSheet.UsedRange.Rows.Count + 1    '之前插入了一行空白行+1
    maxC = ActiveSheet.UsedRange.Columns.Count + 1   '之前插入了一列空白列+1
    Range(Cells(2, 2), Cells(maxR, maxC + 1)).Select '选择B2单位格到最后一个非空单元格，并选多一列空白列
    'ActiveSheet.UsedRange.Select
    
    '设置自动列宽
    Selection.EntireColumn.AutoFit
    
    '数字格式的单元格设置为蓝色,添加千位分隔符
    Dim rng As Range
    For Each rng In ActiveSheet.UsedRange
        If rng.HasFormula Then     '判断单元格是否有公式，有公式则将字体设置为黑色
            rng.Font.Color = RGB(0, 0, 0)
        Else
            If VarType(rng) = 5 Then         '判断单元格类型是否为数字
                rng.Font.Color = RGB(0, 112, 192)     '设置为蓝色（或-4165632）
                'rng.Style = "Comma"     '添加千位分隔符
                'rng.NumberFormatLocal = "_ * #,##0_ ;_ * -#,##0_ ;_ * ""-""??_ ;_ @_ "
            End If
        End If
    Next
    
    '设置选择单元格区域的边框
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    
    '设置所选区域第一行的底边框为无边框
    'Debug.Print Selection.Rows(1).Address
    Selection.Rows(1).Borders(xlEdgeBottom).LineStyle = xlNone
    
    '第一列和最后一列空白列设置宽度为3
    Columns("A").ColumnWidth = 3
    'Debug.Print ActiveSheet.UsedRange.Columns.Count
    Columns(ActiveSheet.UsedRange.Columns.Count + 1).ColumnWidth = 3
    
    '不显示网格线
    ActiveWindow.DisplayGridlines = False
    
    '设置打印页面
    With ActiveSheet.PageSetup
        .CenterFooter = "&P"      '页脚设置页码
        .CenterHorizontally = True   '水平居中打印
        .PrintArea = Selection.Address '设置打印区域
    End With

    '打开屏幕刷新
    Application.ScreenUpdating = True
    
End Sub

向右缩进的代码，要先选择需要向右缩进的单元格，再执行代码

Sub 向右缩进一列()
'
'选中单元格区域向右缩进一列
'

    Dim rng As Range
    
    Selection(1).Offset(0, 1).EntireColumn.Insert shift:=xlShiftToRight   '右边插入一列
    For Each rng In Selection
        rng.Offset(0, 1).Value = rng.Value  '将值复制到右边一个单元格中
        rng.ClearContents                   '删除原单元格内容
    Next
    
    Selection(1).EntireColumn.ColumnWidth = 1   '设置原单元格所在列列宽为1
End Sub