excelvba編程實(shí)例

1、Sub direct_Price()''定義變量Dim cRows As Integer總行數(shù)Dim cColumns As Integer總列數(shù)Dim HEADERCOLORINDEX As Intege表頭的背景色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 colIndex As Integer &

2、#39;臨時(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)閉所有彈出的警告消息= False'設(shè)置需要處理的單元表Sheets(TABLENAME).Select'取單元表的

3、總列數(shù)與總行數(shù)cRows = Sheets(TABLENAME). = Sheets(TABLENAME).'選擇所有的單元格Range(Cells(1, 1), Cells(cRows, cColumns).Select'設(shè)置該表中所有單元行高為'設(shè)置該表中所有單元行高為'設(shè)置所有的邊框(xlDiagonalDown).LineStyle = xlNone(xlDiagonalUp).LineStyle = xlNoneWith (xlEdgeLeft).LineStyle = xlContinuous.Weight = xlThin.colorIndex =

4、 xlAutomaticEnd WithWith (xlEdgeTop).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith (xlEdgeBottom).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticWith (xlEdgeRight).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith (xlInsid

5、eVertical).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd With'并且拆分所有的單元格With Selection.MergeCells = False拆分單格End WithColumns("C:C").SelectShift:=xlToRight'刪除第一列 ,注意這里必須先拆分單格，再刪除第一列，否則一次就會(huì)把合并單元格所在列全部刪除Range(Cells(1, 1), Cells(1, 1).Select ''向表頭添加一行Rows

6、("1:1").SelectColumns("A:A").SelectColumns("B:B").SelectColumns("C:C").SelectColumns("D:D").SelectColumns("E:E").SelectColumns("F:F").Select''''' 設(shè)定單元格A1:A2'''合并A1:A2單元格Range("A1:A2").Sele

7、ct'將數(shù)據(jù)寫(xiě)回With Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = True'往該單元格中寫(xiě)入U(xiǎn)sage_Var= "Price"'設(shè)置該單元格字體格式With (Start:=1, Length:=5).Font.Name = "

8、Arial".FontStyle = "加粗傾斜 ".Size = 10.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = 2End With'單元格設(shè)定邊框(xlDiagonalDown).LineStyle = xlNone(xlDiagonalUp).LineStyle = xlNone(xlEdgeTop).LineSt

9、yle = xlNoneWith (xlEdgeBottom).LineStyle = xlContinuous.Weight = xlThin.colorIndex = 56(xlInsideHorizontal).LineStyle = xlNoneWith.colorIndex = 5.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd With''''' 設(shè)定頭兩行的內(nèi)部樣式'''''Range("B1:B2").SelectRang

10、e("C1:C2").SelectRange("D1:D2").SelectRange("B1:D2").Select'設(shè)置頭兩行行高為With.Name = "Arial".FontStyle = "加粗 ".Size = 8 .Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.co

11、lorIndex = xlAutomaticEnd WithWith Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.WrapText = True.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContextEnd WithWith.colorIndex = HEADERCOLORINDEX.Pattern = xlSolid.PatternColorIndex = xlAu

12、tomaticEnd WithRange("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

13、End WithRange("E1:F1").SelectWith.Name = "Arial".FontStyle = "加粗 ".Size = 8.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = 5With Selection.HorizontalAlignment = xlCenter.Vertic

14、alAlignment = xlCenter.WrapText = True.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = TrueEnd WithWith.colorIndex = HEADERCOLORINDEX.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd With= "Price"Range("E2:F2").Selec

15、t'設(shè)置頭兩行行高為With.Name = "Arial".FontStyle = "加粗 ".Size = 8.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = xlAutomaticEnd WithWith Selection.HorizontalAlignment = xlCenter.VerticalAlign

16、ment = xlCenter.WrapText = True.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd WithWith.colorIndex = HEADERCOLORINDEX.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd With'加第一二行邊框Range("A1:F2").Select(xlDiagonalD

17、own).LineStyle = xlNone (xlDiagonalUp).LineStyle = xlNone With (xlEdgeLeft).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith (xlEdgeTop).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith (xlEdgeBottom).LineStyle = xlContinuous.Weight = xlThin.

18、colorIndex = xlAutomaticEnd WithWith (xlEdgeRight).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith (xlInsideVertical).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith (xlInsideHorizontal).LineStyle = xlContinuous.Weight = xlThin.colorIndex =

19、 xlAutomaticEnd With'去掉第三行的:號(hào)'sTempString = Right(Cells(3, 1), Len(Cells(3, 1) - 3)' = sTempStringi = 2j = 1' 外層循環(huán)判斷是否都合并完成,這里插入了一行，加1While i <= cRows' i = i + 1Range(Cells(i + 1, j), Cells(i + 1, j).Select'去掉分類(lèi)行中的:號(hào)If (Len(Cells(i + 1, j) >= 3) Then''如果是分格的界限If

20、 (Left(Cells(i + 1, j), 3) = " : ") ThenRange(Cells(i + 1, j), Cells(i + 1, cColumns).Select'對(duì)第三行進(jìn)行設(shè)定'設(shè)置頭兩行行高為= 18With.colorIndex = 2.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd With'合并前兩格'先將其合并With Selection.HorizontalAlignment = xlLeft '靠左對(duì)齊.Orientation = 0.A

21、ddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd With'合并'對(duì)其設(shè)定字體風(fēng)格With.Name = "Arial".FontStyle = "加粗傾斜 ".Size = 9.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline =

22、xlUnderlineStyleNone.colorIndex = 3End WithWith Selection.HorizontalAlignment = xlLeft.VerticalAlignment = xlCenter.WrapText = True.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = TrueEnd WithsTempString = Right(Cells(i + 1, j), Len(Cells(i

23、 + 1, j) - 3)= sTempStringi = i + 1End IfEnd If'加 1 后判斷是否到了表尾，沒(méi)有繼續(xù)合并處理'If (i <= cRows + 1) ThenrowIndex = i'取出Cells(ij勺內(nèi)容sTempString = Cells(i, j)'循環(huán)判斷下一個(gè)單元格是否和上一個(gè)單元格相等，不是則表示到此該合并While sTempString = Cells(i + 1,j) And i <= cRowsi = i + 1Wend設(shè)置第一列 '''''跳出循環(huán)表示

24、已經(jīng)到此該將rowIndex 和 i 行合并Range(Cells(rowIndex,j), Cells(i,j).Select'將原來(lái)內(nèi)容填充進(jìn)來(lái)= sTempString' 設(shè)合并后的單元格的邊框With Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.WrapText = True.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeC

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

26、 False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = 5End WithWith Selection.HorizontalAlignment = xlCenter.WrapText = True.VerticalAlignment = xlCenter.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd With(xlDiagonal

27、Down).LineStyle = xlNone(xlDiagonalUp).LineStyle = xlNoneWith (xlEdgeLeft).LineStyle = xlContinuous.Weight = xlThin.colorIndex = 56End WithWith (xlEdgeTop).LineStyle = xlContinuous.Weight = xlThin.colorIndex = 56End WithWith (xlEdgeBottom).LineStyle = xlContinuous.Weight = xlThin.colorIndex = 56End

28、WithWith (xlEdgeRight).LineStyle = xlContinuous.Weight = xlThin.colorIndex = 56End With(xlInsideHorizontal).LineStyle = xlNone''''' 設(shè)置第二列結(jié)束''''修改原來(lái)單元格的數(shù)據(jù)格式''首先向任一無(wú)用的單元格寫(xiě)入數(shù)據(jù)Range(Cells(cRows + 2, cColumns), Cells(cRows + 2, cColumns).Select= "1"&#

29、39;將其格式拷貝'復(fù)制格式Range(Cells(rowIndex, j + 4), Cells(i, cColumns).SelectPaste:=xlPasteAll, Operation:=xlMultiply, _SkipBlanks:=False, Transpose:=False= "_*#,#"'清除原來(lái)內(nèi)容Range(Cells(cRows + 2, cColumns), Cells(cRows + 2, cColumns).Select設(shè)定數(shù)據(jù)格式完成'''''''統(tǒng)一設(shè)置該區(qū)域的顏

30、色'''''設(shè)置內(nèi)部填充Range(Cells(rowIndex, j), Cells(i, cColumns).SelectcolorIndex = colorIndex + 1If colorIndex > 39 ThencolorIndex = 33End IfWith.colorIndex = colorIndex '顏色.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd With'''' 統(tǒng)一設(shè)置該區(qū)域的顏色結(jié)束'''&

31、#39; ''''' 設(shè)置剩余的列 '''Range(Cells(rowIndex, j + 2), Cells(i, cColumns).Select'設(shè)置字體With.Name = "Arial".FontStyle = "常規(guī) ".Size = 8.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderli

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

33、h''''' 設(shè)置全部的邊框'''Range(Cells(rowIndex, j), Cells(i, cColumns).Select'設(shè)置邊框(xlDiagonalDown).LineStyle = xlNone(xlDiagonalUp).LineStyle = xlNoneWith (xlEdgeLeft).LineStyle = xlContinuous.Weight = xlThinEnd WithWith (xlEdgeTop).LineStyle = xlContinuous.Weight = xlThin

34、.colorIndex = xlAutomaticEnd WithWith (xlEdgeBottom).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith (xlEdgeRight).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith (xlInsideVertical).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAu

35、tomaticEnd WithWith (xlInsideHorizontal)' .LineStyle = xlContinuous.Weight = xlThin' .colorIndex = xlAutomaticEnd WithWendRange(Cells(rowIndex - 1, 1), Cells(rowIndex - 1, cColumns).Select= FalseRange(Cells(rowIndex - 1, cColumns - 1), Cells(rowIndex - 1, cColumns - 1).SelectWith Selection.H

36、orizontalAlignment = xlCenter.VerticalAlignment = xlCenter.WrapText = True.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd WithWith.Name = "Arial".FontStyle = "加粗 ".Size = 8.Strikethrough = False.Superscript = F

37、alse.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNoneEnd WithWith.colorIndex = 15.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd With= "Average"With (Start:=1, Length:=7).Font.Name = "Arial".FontStyle = "加粗 ".Size = 8.Strikethr

38、ough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = xlAutomaticEnd WithRange(Cells(rowIndex - 1, cColumns), Cells(rowIndex - 1, cColumns).SelectWith Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.WrapText = True.Orientation = 0 .AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd WithWith.Name = "Aria