excelvba编程实例大全

1、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 Int

2、eger 临时生成的颜色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(Cells(1, 1), Cel

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

4、ex = 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 .colorIndex

5、= 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).Select = Column

6、s(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 .MergeCells = T

7、rue 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 单元格设定边框 (xlDiag

8、onalDown).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 = xlAutomatic End

9、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 .colorIndex =

10、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 .PatternColorIndex =

11、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:F1).Select W

12、ith .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 .Or

13、ientation = 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 .FontStyle = 加粗 .Siz

14、e = 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 = F

15、alse .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 = xlNone With (x

16、lEdgeLeft) .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 (xlEdgeRight)

17、 .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 去掉第三行的:号 sTempS

18、tring = 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 .PatternColorIndex

19、 = 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 .Strikethrough = False .S

20、uperscript = 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

21、.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) 循环判断下一个单元格是否和上一个单元格相等，不是则表示到此该合并 Wh

22、ile 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 .Striketh

23、rough = 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 .Name = Arial .FontStyle = 常规 .Size = 8 .Strikethrough = False .Supersc

24、ript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .colorIndex = 3 End With 设置全部的边框 Range(Cells(rowIndex, j), Cells(i, cColumns).Select 设置边框 (xlDiagonalDown).LineStyle = xlNone (xlDiagonalUp).LineStyle = xlNone With (xlEdgeLeft) .LineStyle = xlCont

25、inuous .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 (xlEdgeRight) .LineStyle = xlContinuous .We

26、ight = xlThin .colorIndex = xlAutomatic End With With (xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .colorIndex = xlAutomatic End With With (xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .colorIndex = xlAutomatic End WithWend Range(Cells(rowIndex - 1, 1), Cells(rowIn

27、dex - 1, cColumns).Select = 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 =

28、xlContext .MergeCells = False End With With .Name = Arial .FontStyle = 加粗 .Size = 8 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .colorIndex = xlAutomatic End With With .colorIndex = 15 .Pattern = xlSolid .Patte

29、rnColorIndex = xlAutomatic End With = Average With (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(r

30、owIndex - 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 .Name = Arial .FontStyle = 加粗 .Size = 8 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .colorIndex = xlAutomatic End With With .colorIndex = 15 .Pattern = xlSolid .PatternColor