Excel VBA編程實(shí)例

1、Sub direct_Price()''定義變量Dim cRows As Integer '總行數(shù)Dim cColumns As Integer '總列數(shù)Dim HEADERCOLORINDEX As Integer '表頭的背景色Dim cTemp As Integer '臨時(shí)計(jì)數(shù)Dim sTempString As String '臨時(shí)字符串變量Dim i As Integer '臨時(shí)計(jì)數(shù)Dim j As Integer '臨時(shí)計(jì)數(shù)Dim rowIndex As Integer '臨時(shí)指示處理到哪里Dim co

2、lIndex As Integer '臨時(shí)指示處理到哪里Dim tempRndColor As Integer '臨時(shí)生成的顏色Dim TABLENAME As String '待處理的表名 Dim colorIndex As String '顏色索引名字'表頭的背景色HEADERCOLORINDEX = 15colorIndex = 36 '顏色從33開(kāi)始是比較淺的顏色TABLENAME = "direct_Price"'關(guān)閉所有彈出的警告消息Application.DisplayAlerts = False'

3、;設(shè)置需要處理的單元表Sheets(TABLENAME).Select '取單元表的總列數(shù)與總行數(shù) '''' '選擇所有的單元格 Range(Cells(1, 1), Cells(cRows, cColumns).Select '設(shè)置該表中所有單元行高為11.25 Selection.RowHeight = 11.25 '設(shè)置該表中所有單元行高為11.25 Selection.RowHeight = 11.25 '設(shè)置所有的邊框 Selection.Borders(xlDiagonalDown).LineStyle = x

4、lNone 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.Bor

5、ders(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 .colo

6、rIndex = xlAutomatic End With '并且拆分所有的單元格 With Selection .MergeCells = False '拆分單格 End With Columns("C:C").Select Selection.Insert Shift:=xlToRight '刪除第一列,注意這里必須先拆分單格，再刪除第一列，否則一次就會(huì)把合并單元格所在列全部刪除 Range(Cells(1, 1), Cells(1, 1).Select '向表頭添加一行 Rows("1:1").Select Sele

7、ction.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.ColumnWi

8、dth = 12.29Columns("F:F").SelectSelection.ColumnWidth = 12.29 '''''設(shè)定單元格A1:A2'' '合并A1:A2單元格 Range("A1:A2").Select '將數(shù)據(jù)寫回 With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Orientation = 0 .AddIndent = False .IndentLev

9、el = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With '往該單元格中寫入U(xiǎn)sage_Var ActiveCell.FormulaR1C1 = "Price" '設(shè)置該單元格字體格式 With ActiveCell.Characters(Start:=1, Length:=5).Font .Name = "Arial" .FontStyle = "加粗 傾斜" .Size = 10 .Strikethrough

10、= False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .colorIndex = 2 End With '單元格設(shè)定邊框 Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle

11、= 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 '''''設(shè)定

12、頭兩行的內(nèi)部樣式''''' Range("B1:B2").Select Selection.Merge Range("C1:C2").Select Selection.Merge Range("D1:D2").Select Selection.Merge Range("B1:D2").Select '設(shè)置頭兩行行高為11.25 Selection.RowHeight = 14.25 With Selection.Font .Name = "Arial&quo

13、t; .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 = T

14、rue .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&quo

15、t; 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&quo

16、t;).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

17、 .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 ActiveCe

18、ll.FormulaR1C1 = "Price" Range("E2:F2").Select '設(shè)置頭兩行行高為11.25 Selection.RowHeight = 14.25 With Selection.Font .Name = "Arial" .FontStyle = "加粗" .Size = 8 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .U

19、nderline = 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 Selec

20、tion.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

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

22、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 .We

23、ight = xlThin .colorIndex = xlAutomatic End With '去掉第三行的:號(hào) 'sTempString = Right(Cells(3, 1), Len(Cells(3, 1) - 3) 'ActiveCell.FormulaR1C1 = sTempString i = 2 j = 1 '外層循環(huán)判斷是否都合并完成,這里插入了一行，加1 While i <= cRows ' i = i + 1 Range(Cells(i + 1, j), Cells(i + 1, j).Select '去掉分類行中的

24、:號(hào) 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 '對(duì)第三行進(jìn)行設(shè)定 '設(shè)置頭兩行行高為11.25 Selection.RowHeight = 18 With Selection.Interior .colorIndex = 2 .Pattern = xlSolid .PatternColorInde

25、x = xlAutomatic End With '合并前兩格 '先將其合并 With Selection .HorizontalAlignment = xlLeft '靠左對(duì)齊 .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With '合并 Selection.Merge '對(duì)其設(shè)定字體風(fēng)格 With Selection.Font .Name = &qu

26、ot;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

27、= 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后判斷是否到了表尾，沒(méi)有繼續(xù)合并處理 'I

28、f (i <= cRows + 1) Then rowIndex = i '取出Cells(i, j)的內(nèi)容 sTempString = Cells(i, j) '循環(huán)判斷下一個(gè)單元格是否和上一個(gè)單元格相等，不是則表示到此該合并 While sTempString = Cells(i + 1, j) And i <= cRows i = i + 1 Wend 設(shè)置第一列'''' '跳出循環(huán)表示已經(jīng)到此該將rowIndex 和 i行合并 Range(Cells(rowIndex, j), Cells(i, j).Select S

29、election.Merge '將原來(lái)內(nèi)容填充進(jìn)來(lái) ActiveCell.FormulaR1C1 = sTempString '設(shè)合并后的單元格的邊框 With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End

30、 With Selection.Font.FontStyle = "加粗" 設(shè)置第一列結(jié)束'''' '''設(shè)置第二列''' Range(Cells(rowIndex, j + 1), Cells(i, j + 1).Select '設(shè)置字體 With Selection.Font .Name = "Arial" .FontStyle = "加粗" .Size = 8 .Strikethrough = False .Superscript = Fal

31、se .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

32、= 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 = xlCo

33、ntinuous .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)

34、.LineStyle = xlNone '''''設(shè)置第二列結(jié)束''' '修改原來(lái)單元格的數(shù)據(jù)格式''首先向任一無(wú)用的單元格寫入數(shù)據(jù) Range(Cells(cRows + 2, cColumns), Cells(cRows + 2, cColumns).Select ActiveCell.FormulaR1C1 = "1" '將其格式拷貝 Selection.Copy '復(fù)制格式 Range(Cells(rowIndex, j + 4), Cells(i, cColum

35、ns).Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _ SkipBlanks:=False, Transpose:=False Selection.NumberFormatLocal = "_*#,#0.00000" '清除原來(lái)內(nèi)容 Range(Cells(cRows + 2, cColumns), Cells(cRows + 2, cColumns).Select Selection.ClearContents設(shè)定數(shù)據(jù)格式完成''''

36、 '''統(tǒng)一設(shè)置該區(qū)域的顏色'''' '設(shè)置內(nèi)部填充 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 En

37、d With ''''統(tǒng)一設(shè)置該區(qū)域的顏色結(jié)束'''' '''''設(shè)置剩余的列''' Range(Cells(rowIndex, j + 2), Cells(i, cColumns).Select '設(shè)置字體 With Selection.Font .Name = "Arial" .FontStyle = "常規(guī)" .Size = 8 .Strikethrough = False .Superscript = False

38、 .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .colorIndex = xlAutomatic End With '設(shè)置第6列 Range(Cells(rowIndex, j + 4), Cells(i, j + 5).Select '設(shè)置字體 With Selection.Font .Name = "Arial" .FontStyle = "常規(guī)" .Size = 8 .Strikethrough =

39、 False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .colorIndex = 3 End With '''''設(shè)置全部的邊框''' Range(Cells(rowIndex, j), Cells(i, cColumns).Select '設(shè)置邊框 Selection.Borders(xlDiagonalDown).LineStyle = x

40、lNone 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.Bor

41、ders(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 .colo

42、rIndex = 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 -

43、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 = &quo

44、t;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

45、= 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 = xl

46、UnderlineStyleNone .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 = "Aria