Excel VBA编程实例.docx

1、Excel VBA编程实例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 tempRn

2、dColor 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.

3、CountcColumns = Sheets(TABLENAME).UsedRange.Columns.CountEOIuB。 选择所有的单元格 Range(Cells(1, 1), Cells(cRows, cColumns).Select 设置该表中所有单元行高为11.25 Selection.RowHeight = 11.25 设置该表中所有单元行高为11.25 Selection.RowHeight = 11.25 设置所有的边框 Selection.Borders(xlDiagonalDown).LineStyle = xlNoneS2rLG。 Selection.Borders(x

4、lDiagonalUp).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) .LineS

5、tyle = 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

6、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.Ins

7、ert 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:A

8、2 合并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 设置该单元格字

9、体格式 With ActiveCell.Characters(Start:=1, Length:=5).FontW0A7c。 .Name = Arial .FontStyle = 加粗 倾斜 .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .colorIndex = 2 End With 单元格设定边框 Selection.Borders(xlDiagon

10、alDown).LineStyle = xlNonefOxR7。 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 = xlNonefGaap。

11、 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.Fo

12、nt .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 =

13、 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.Cha

14、racters(Start:=1, Length:=4).Font9SEMC。 .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 .FontSt

15、yle = 加粗 .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

16、= 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

17、 = 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 .VerticalAlignm

18、ent = 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).Se

19、lect Selection.Borders(xlDiagonalDown).LineStyle = xlNonehOUNi。 Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .colorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xl

20、Thin .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(xlInside

21、Vertical) .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)GiwW2。 ActiveCell.FormulaR1C1

22、 = 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).SelectxtwBS。 对第三行进行设定 设置头两行行高为11.25 Selection.RowHeight = 18 With Selection.Interior .colorIndex = 2 .Pattern = xlSolid .PatternColorIn

23、dex = 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 = 加粗 倾斜 .

24、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 .Ind

25、entLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With sTempString = Right(Cells(i + 1, j), Len(Cells(i + 1, j) - 3)OXPTP。 ActiveCell.FormulaR1C1 = sTempString i = i + 1 End If End If i = i + 1 加1后判断是否到了表尾，没有继续合并处理 If (i = cRows + 1) Then rowIndex = i 取出Cells(i, j)的内

26、容 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 .Hori

27、zontalAlignment = 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).SelectMe

28、x62。 设置字体 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 = xlC

29、enter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Borders(xlDiagonalDown).LineStyle = xlNoneh7pGG。 Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weigh