VBA编程实例

''定义变量

Dim cRows As Integer '总行数

Dim cColumns As Integer '总列数

Dim HEADERCOLORINDEX As Integer  '表头的背景色

Dim cTemp As Integer  '临时计数

Dim sTempString As String  '临时字符串变量

Dim i As Integer  '临时计数

Dim j As Integer  '临时计数

Dim rowIndex As Integer  '临时指示处理到哪里

Dim colIndex As Integer  '临时指示处理到哪里

Dim tempRndColor As Integer  '临时生成的颜色

Dim TABLENAME As String  '待处理的表名 

Dim colorIndex As String  '颜色索引名字

''''''''''''''''''''''''''''''''''''''''''''''

'表头的背景色

HEADERCOLORINDEX = 15

colorIndex = 36 '颜色从33开始是比较浅的颜色

TABLENAME = "direct_Price"

'关闭所有弹出的警告消息

Application.DisplayAlerts = False

'设置需要处理的单元表

Sheets(TABLENAME).Select

 '取单元表的总列数与总行数

cRows = Sheets(TABLENAME).UsedRange.Rows.Count

cColumns = Sheets(TABLENAME).UsedRange.Columns.Count

''''''''''''''''''''''''''''''''''''''''''''''

     '选择所有的单元格

 Range(Cells(1, 1), Cells(cRows, cColumns)).Select

   '设置该表中所有单元行高为11.25

 Selection.RowHeight = 11.25

'设置该表中所有单元行高为11.25

 Selection.RowHeight = 11.25

 '设置所有的边框

 Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

   '并且拆分所有的单元格

 With Selection

        .MergeCells = False '拆分单格

 End With

 Columns("C:C").Select

 Selection.Insert Shift:=xlToRight

  '删除第一列,注意这里必须先拆分单格，再删除第一列，否则一次就会把合并单元格所在列全部删除

 Range(Cells(1, 1), Cells(1, 1)).Select

 Selection.EntireColumn.Delete

 'Selection.EntireColumn.Delete

   '向表头添加一行

  Rows("1:1").Select

  Selection.Insert

Columns("A:A").Select

Selection.ColumnWidth = 9.29

Columns("B:B").Select

Selection.ColumnWidth = 6.71

Columns("C:C").Select

Selection.ColumnWidth = 15.29

Columns("D:D").Select

Selection.ColumnWidth = 29.86

Columns("E:E").Select

Selection.ColumnWidth = 12.29

Columns("F:F").Select

Selection.ColumnWidth = 12.29

    '''''''''''''''''''''''''''''''''''设定单元格A1:A2''''''''''''''''''''

     '合并A1:A2单元格

    Range("A1:A2").Select

    '将数据写回

     With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = True

    End With

    '往该单元格中写入Usage_Var

    ActiveCell.FormulaR1C1 = "Price"

    '设置该单元格字体格式

    With ActiveCell.Characters(Start:=1, Length:=5).Font

        .Name = "Arial"

        .FontStyle = "加粗 倾斜"

        .Size = 10

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .colorIndex = 2

    End With

    '单元格设定边框

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = 56

    End With

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    With Selection.Interior

        .colorIndex = 5

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

    End With

  '''''''''''''''''''''''''''''设定头两行的内部样式'''''''''''''''''''''''

     Range("B1:B2").Select

     Selection.Merge

     Range("C1:C2").Select

    Selection.Merge

     Range("D1:D2").Select

     Selection.Merge

    Range("B1:D2").Select

  '设置头两行行高为11.25

   Selection.RowHeight = 14.25

    With Selection.Font

        .Name = "Arial"

        .FontStyle = "加粗"

        .Size = 8

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .colorIndex = xlAutomatic

    End With

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

    End With

    With Selection.Interior

        .colorIndex = HEADERCOLORINDEX

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

    End With

    Range("B1:B2").Select

    ActiveCell.FormulaR1C1 = "Type"

    With ActiveCell.Characters(Start:=1, Length:=4).Font

        .Name = "Arial"

        .FontStyle = "加粗"

        .Size = 8

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .colorIndex = 5

    End With

     Range("E1:F1").Select

         With Selection.Font

        .Name = "Arial"

        .FontStyle = "加粗"

        .Size = 8

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .colorIndex = 5

    End With

   With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = True

    End With

    With Selection.Interior

        .colorIndex = HEADERCOLORINDEX

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

    End With

     ActiveCell.FormulaR1C1 = "Price"

    Range("E2:F2").Select

  '设置头两行行高为11.25

   Selection.RowHeight = 14.25

    With Selection.Font

        .Name = "Arial"

        .FontStyle = "加粗"

        .Size = 8

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .colorIndex = xlAutomatic

    End With

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    With Selection.Interior

        .colorIndex = HEADERCOLORINDEX

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

    End With

    '加第一二行边框

    Range("A1:F2").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    '去掉第三行的:号

    'sTempString = Right(Cells(3, 1), Len(Cells(3, 1)) - 3)

    'ActiveCell.FormulaR1C1 = sTempString

    i = 2

    j = 1

   '外层循环判断是否都合并完成,这里插入了一行，加1

   While i <= cRows

   ' i = i + 1

     Range(Cells(i + 1, j), Cells(i + 1, j)).Select

    '去掉分类行中的:号

    If (Len(Cells(i + 1, j)) >= 3) Then

      ''''''''''''''如果是分格的界限''''''''''''''''''''''''''''''''''''

      If (Left(Cells(i + 1, j), 3) = " : ") Then

          Range(Cells(i + 1, j), Cells(i + 1, cColumns)).Select

        '对第三行进行设定

        '设置头两行行高为11.25

        Selection.RowHeight = 18

      With Selection.Interior

         .colorIndex = 2

         .Pattern = xlSolid

         .PatternColorIndex = xlAutomatic

       End With

       '合并前两格

       '先将其合并

      With Selection

        .HorizontalAlignment = xlLeft '靠左对齐

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

       End With

    '合并

     Selection.Merge

    '对其设定字体风格

    With Selection.Font

        .Name = "Arial"

        .FontStyle = "加粗 倾斜"

        .Size = 9

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .colorIndex = 3

    End With

    With Selection

        .HorizontalAlignment = xlLeft

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = True

    End With

        sTempString = Right(Cells(i + 1, j), Len(Cells(i + 1, j)) - 3)

        ActiveCell.FormulaR1C1 = sTempString

        i = i + 1

      End If

    End If

    i = i + 1

    '加1后判断是否到了表尾，没有继续合并处理

    'If (i <= cRows + 1) Then

     rowIndex = i

     '取出Cells(i, j)的内容

    sTempString = Cells(i, j)

    '循环判断下一个单元格是否和上一个单元格相等，不是则表示到此该合并

   While sTempString = Cells(i + 1, j) And i <= cRows

     i = i + 1

   Wend

   ''''''''''''''''''''''''''''''''''''设置第一列''''''''''''''''''''''''''''''''''''''''

   '跳出循环表示已经到此该将rowIndex 和 i行合并

   Range(Cells(rowIndex, j), Cells(i, j)).Select

   Selection.Merge

    '将原来内容填充进来

    ActiveCell.FormulaR1C1 = sTempString

   '设合并后的单元格的边框

    With Selection

    .HorizontalAlignment = xlCenter

    .VerticalAlignment = xlCenter

    .WrapText = True

    .Orientation = 0

    .AddIndent = False

    .IndentLevel = 0

    .ShrinkToFit = False

    .ReadingOrder = xlContext

    .MergeCells = True

    End With

    Selection.Font.FontStyle = "加粗"

     ''''''''''''''''''''''''''''''''''''设置第一列结束''''''''''''''''''''''''''''''''''''''''

     '''''''''''''''''''''''''''''''''''''''设置第二列'''''''''''''''''''''''''''''''''''''''''''''

     Range(Cells(rowIndex, j + 1), Cells(i, j + 1)).Select

          '设置字体

     With Selection.Font

     .Name = "Arial"

     .FontStyle = "加粗"

     .Size = 8

     .Strikethrough = False

     .Superscript = False

     .Subscript = False

     .OutlineFont = False

     .Shadow = False

     .Underline = xlUnderlineStyleNone

     .colorIndex = 5

     End With

    With Selection

    .HorizontalAlignment = xlCenter

    .VerticalAlignment = xlCenter

    .WrapText = True

    .Orientation = 0

    .AddIndent = False

    .IndentLevel = 0

    .ShrinkToFit = False

    .ReadingOrder = xlContext

    .MergeCells = False

    End With

     Selection.Borders(xlDiagonalDown).LineStyle = xlNone

     Selection.Borders(xlDiagonalUp).LineStyle = xlNone

     With Selection.Borders(xlEdgeLeft)

         .LineStyle = xlContinuous

         .Weight = xlThin

         .colorIndex = 56

     End With

     With Selection.Borders(xlEdgeTop)

         .LineStyle = xlContinuous

         .Weight = xlThin

         .colorIndex = 56

     End With

     With Selection.Borders(xlEdgeBottom)

         .LineStyle = xlContinuous

         .Weight = xlThin

         .colorIndex = 56

     End With

     With Selection.Borders(xlEdgeRight)

         .LineStyle = xlContinuous

         .Weight = xlThin

         .colorIndex = 56

     End With

     Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

'''''''''''''''''''''''''''''设置第二列结束'''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''修改原来单元格的数据格式''''''''''''''''''''''''''''''''

''''''''''''''''''''''''首先向任一无用的单元格写入数据

   Range(Cells(cRows + 2, cColumns), Cells(cRows + 2, cColumns)).Select

   ActiveCell.FormulaR1C1 = "1"

   '将其格式拷贝

   Selection.Copy

  '复制格式

   Range(Cells(rowIndex, j + 4), Cells(i, cColumns)).Select

   Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _

   SkipBlanks:=False, Transpose:=False

   Selection.NumberFormatLocal = "_*#,##0.00000"

   '清除原来内容

   Range(Cells(cRows + 2, cColumns), Cells(cRows + 2, cColumns)).Select

   Selection.ClearContents

''''''''''''''''''''''''设定数据格式完成''''''''''''''''''''''''''''''''''''''''''''''

 '''''''''''''''''''''''''''''''''''''''统一设置该区域的颜色''''''''''''''''''''''''''''''''''''''''''''''

     '设置内部填充

     Range(Cells(rowIndex, j), Cells(i, cColumns)).Select

     colorIndex = colorIndex + 1

     If colorIndex > 39 Then

        colorIndex = 33

    End If

     With Selection.Interior

             .colorIndex = colorIndex '颜色

             .Pattern = xlSolid

             .PatternColorIndex = xlAutomatic

     End With

 ''''''''''''''''''''''''''''''''''统一设置该区域的颜色结束''''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''设置剩余的列'''''''''''''''''''''''''''''''''''''''''''''

    Range(Cells(rowIndex, j + 2), Cells(i, cColumns)).Select

    '设置字体

   With Selection.Font

      .Name = "Arial"

      .FontStyle = "常规"

      .Size = 8

      .Strikethrough = False

       .Superscript = False

      .Subscript = False

     .OutlineFont = False

       .Shadow = False

     .Underline = xlUnderlineStyleNone

     .colorIndex = xlAutomatic

     End With

    '设置第6列

    Range(Cells(rowIndex, j + 4), Cells(i, j + 5)).Select

          '设置字体

     With Selection.Font

      .Name = "Arial"

      .FontStyle = "常规"

      .Size = 8

      .Strikethrough = False

       .Superscript = False

      .Subscript = False

     .OutlineFont = False

       .Shadow = False

     .Underline = xlUnderlineStyleNone

     .colorIndex = 3

     End With

    '''''''''''''''''''''''''''''设置全部的边框'''''''''''''''''''''''''''''''''''''''''''''

    Range(Cells(rowIndex, j), Cells(i, cColumns)).Select

    '设置边框

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlInsideHorizontal)

      '  .LineStyle = xlContinuous

        .Weight = xlThin

       ' .colorIndex = xlAutomatic

    End With

Wend

 Range(Cells(rowIndex - 1, 1), Cells(rowIndex - 1, cColumns)).Select

 Selection.MergeCells = False

 Range(Cells(rowIndex - 1, cColumns - 1), Cells(rowIndex - 1, cColumns - 1)).Select

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    With Selection.Font

        .Name = "Arial"

        .FontStyle = "加粗"

        .Size = 8

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .colorIndex = xlAutomatic

    End With

    With Selection.Interior

        .colorIndex = 15

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

    End With

    ActiveCell.FormulaR1C1 = "Average"

    With ActiveCell.Characters(Start:=1, Length:=7).Font

        .Name = "Arial"

        .FontStyle = "加粗"

        .Size = 8

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .colorIndex = xlAutomatic

    End With

    Range(Cells(rowIndex - 1, cColumns), Cells(rowIndex - 1, cColumns)).Select

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    With Selection.Font

        .Name = "Arial"

        .FontStyle = "加粗"

        .Size = 8

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .colorIndex = xlAutomatic

    End With

    With Selection.Interior

        .colorIndex = 15

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

    End With

    ActiveCell.FormulaR1C1 = "Average"

    With ActiveCell.Characters(Start:=1, Length:=7).Font

        .Name = "Arial"

        .FontStyle = "加粗"

        .Size = 8

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .colorIndex = xlAutomatic

    End With

    Range(Cells(rowIndex - 1, cColumns - 1), Cells(rowIndex - 1, cColumns)).Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .colorIndex = xlAutomatic

    End With

    With Selection.Borders(xlInsideHorizontal)

       ' .LineStyle = xlContinuous

        .Weight = xlThin

       ' .colorIndex = xlAutomatic

    End With

End Sub