excelvba编程实例.docx

1、excelvba编程实例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 tempRnd

2、Color As Integer 临时生成的颜色Dim TABLENAME As String 待处理的表名 Dim colorIndex As String 颜色索引名字表头的背景色HEADERCOLORINDEX = 15colorIndex = 36 颜色从33开始是比较浅的颜色TABLENAME = direct_Price关闭所有弹出的警告消息 = False设置需要处理的单元表Sheets(TABLENAME).Select 取单元表的总列数与总行数cRows = Sheets(TABLENAME). = Sheets(TABLENAME). 选择所有的单元格 Range(Cell

3、s(1, 1), Cells(cRows, cColumns).Select 设置该表中所有单元行高为 = 设置该表中所有单元行高为 = 设置所有的边框 (xlDiagonalDown).LineStyle = xlNone (xlDiagonalUp).LineStyle = xlNone With (xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .colorIndex = xlAutomatic End With With (xlEdgeTop) .LineStyle = xlContinuous .Weight = xlTh

4、in .colorIndex = xlAutomatic End With With (xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .colorIndex = xlAutomatic End With With (xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .colorIndex = xlAutomatic End With With (xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin

5、.colorIndex = xlAutomatic End With 并且拆分所有的单元格 With Selection .MergeCells = False 拆分单格 End With Columns(C:C).Select Shift:=xlToRight 删除第一列,注意这里必须先拆分单格，再删除第一列，否则一次就会把合并单元格所在列全部删除 Range(Cells(1, 1), Cells(1, 1).Select 向表头添加一行 Rows(1:1).Select Columns(A:A).Select = Columns(B:B).Select = Columns(C:C).Sel

6、ect = Columns(D:D).Select = Columns(E:E).Select = Columns(F:F).Select = 设定单元格A1:A2 合并A1:A2单元格 Range(A1:A2).Select 将数据写回 With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .Me

7、rgeCells = True End With 往该单元格中写入Usage_Var = Price 设置该单元格字体格式 With (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 单元格

8、设定边框 (xlDiagonalDown).LineStyle = xlNone (xlDiagonalUp).LineStyle = xlNone (xlEdgeTop).LineStyle = xlNone With (xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .colorIndex = 56 End With (xlInsideHorizontal).LineStyle = xlNone With .colorIndex = 5 .Pattern = xlSolid .PatternColorIndex = xlAu

9、tomatic End With 设定头两行的内部样式 Range(B1:B2).Select Range(C1:C2).Select Range(D1:D2).Select Range(B1:D2).Select 设置头两行行高为 = With .Name = Arial .FontStyle = 加粗 .Size = 8 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .c

10、olorIndex = xlAutomatic End With With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext End With With .colorIndex = HEADERCOLORINDEX .Pattern = xlSolid .PatternC

11、olorIndex = xlAutomatic End With Range(B1:B2).Select = Type With (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:

12、F1).Select With .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 .WrapTex

13、t = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With With .colorIndex = HEADERCOLORINDEX .Pattern = xlSolid .PatternColorIndex = xlAutomatic End With = Price Range(E2:F2).Select 设置头两行行高为 = With .Name = Arial .FontSty

14、le = 加粗 .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 .A

15、ddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With .colorIndex = HEADERCOLORINDEX .Pattern = xlSolid .PatternColorIndex = xlAutomatic End With 加第一二行边框 Range(A1:F2).Select (xlDiagonalDown).LineStyle = xlNone (xlDiagonalUp).LineStyle = xl

16、None With (xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .colorIndex = xlAutomatic End With With (xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .colorIndex = xlAutomatic End With With (xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .colorIndex = xlAutomatic End With With (

17、xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .colorIndex = xlAutomatic End With With (xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .colorIndex = xlAutomatic End With With (xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .colorIndex = xlAutomatic End With 去掉第

18、三行的:号 sTempString = Right(Cells(3, 1), Len(Cells(3, 1) - 3) = 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 对第三行进行设定 设置头两行行高为 = 18 With .colorIndex = 2 .Pattern = xlSolid .Patte

19、rnColorIndex = xlAutomatic End With 合并前两格 先将其合并 With Selection .HorizontalAlignment = xlLeft 靠左对齐 .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With 合并 对其设定字体风格 With .Name = Arial .FontStyle = 加粗 倾斜 .Size = 9 .Strikethroug

20、h = 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 .ShrinkTo

21、Fit = False .ReadingOrder = xlContext .MergeCells = True End With sTempString = Right(Cells(i + 1, j), Len(Cells(i + 1, j) - 3) = 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) 循环判断下一个单元格是否和上一个单元格相等，不

22、是则表示到此该合并 While sTempString = Cells(i + 1, j) And i 39 Then colorIndex = 33 End If With .colorIndex = colorIndex 颜色 .Pattern = xlSolid .PatternColorIndex = xlAutomatic End With 统一设置该区域的颜色结束 设置剩余的列 Range(Cells(rowIndex, j + 2), Cells(i, cColumns).Select 设置字体 With .Name = Arial .FontStyle = 常规 .Size = 8 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlin