Excel VBA编程实例.doc

Sub direct_Price()定义变量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 = 15colorIndex = 36 颜色从33开始是比较浅的颜色TABLENAME = direct_Price关闭所有弹出的警告消息Application.DisplayAlerts = False设置需要处理的单元表Sheets(TABLENAME).Select 取单元表的总列数与总行数cRows = Sheets(TABLENAME).UsedRange.Rows.CountcColumns = 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).SelectSelection.ColumnWidth = 9.29Columns(B:B).SelectSelection.ColumnWidth = 6.71Columns(C:C).SelectSelection.ColumnWidth = 15.29Columns(D:D).SelectSelection.ColumnWidth = 29.86Columns(E:E).SelectSelection.ColumnWidth = 12.29Columns(F:F).SelectSelection.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 = 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 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 WithWend 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 = xlA