Excel VBA编程实例Word格式文档下载.docx
《Excel VBA编程实例Word格式文档下载.docx》由会员分享，可在线阅读，更多相关《Excel VBA编程实例Word格式文档下载.docx（24页珍藏版）》请在冰豆网上搜索。
DimTABLENAMEAsString'
待处理的表名
DimcolorIndexAsString'
颜色索引名字
HEADERCOLORINDEX=15
colorIndex=36'
颜色从33开始是比较浅的颜色
TABLENAME="
direct_Price"
关闭所有弹出的警告消息
Application.DisplayAlerts=False
设置需要处理的单元表
Sheets（TABLENAME）.Select
'
取单元表的总列数与总行数
cRows=Sheets（TABLENAME）.UsedRange.Rows.Count
cColumns=Sheets（TABLENAME）.UsedRange.Columns.CountEOIuB。
选择所有的单元格
Range（Cells（1,1）,Cells（cRows,cColumns））.Select
设置该表中所有单元行高为11.25
Selection.RowHeight=11.25
设置所有的边框
Selection.Borders（xlDiagonalDown）.LineStyle=xlNoneS2rLG。
Selection.Borders（xlDiagonalUp）.LineStyle=xlNone
WithSelection.Borders（xlEdgeLeft）
.LineStyle=xlContinuous
.Weight=xlThin
.colorIndex=xlAutomatic
EndWith
WithSelection.Borders（xlEdgeTop）
WithSelection.Borders（xlEdgeBottom）
WithSelection.Borders（xlEdgeRight）
WithSelection.Borders（xlInsideVertical）
并且拆分所有的单元格
WithSelection
.MergeCells=False'
拆分单格
Columns（"
C:
C"
）.Select
Selection.InsertShift:
=xlToRight
删除第一列,注意这里必须先拆分单格，再删除第一列，否则一次就会把合并单元格所在列全部删除
Range（Cells（1,1）,Cells（1,1））.Select
Selection.EntireColumn.Delete
Selection.EntireColumn.Delete
向表头添加一行
Rows（"
1:
1"
Selection.Insert
Columns（"
A:
A"
Selection.ColumnWidth=9.29
B:
B"
Selection.ColumnWidth=6.71
Selection.ColumnWidth=15.29
D:
D"
Selection.ColumnWidth=29.86
E:
E"
Selection.ColumnWidth=12.29
F:
F"
设定单元格A1:
A2'
合并A1:
A2单元格
Range（"
A1:
A2"
将数据写回
.HorizontalAlignment=xlCenter
.VerticalAlignment=xlCenter
.Orientation=0
.AddIndent=False
.IndentLevel=0
.ShrinkToFit=False
.ReadingOrder=xlContext
.MergeCells=True
往该单元格中写入Usage_Var
ActiveCell.FormulaR1C1="
Price"
设置该单元格字体格式
WithActiveCell.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
单元格设定边框
Selection.Borders（xlDiagonalDown）.LineStyle=xlNonefOxR7。
Selection.Borders（xlEdgeTop）.LineStyle=xlNone
.colorIndex=56
Selection.Borders（xlInsideHorizontal）.LineStyle=xlNonefGaap。
WithSelection.Interior
.colorIndex=5
.Pattern=xlSolid
.PatternColorIndex=xlAutomatic
设定头两行的内部样式'
B1:
B2"
Selection.Merge
C1:
C2"
D1:
D2"
设置头两行行高为11.25
Selection.RowHeight=14.25
WithSelection.Font
加粗"
.Size=8
.WrapText=True
.colorIndex=HEADERCOLORINDEX
Type"
=4）.Font9SEMC。
E1:
F1"
E2:
F2"
.MergeCells=False
加第一二行边框
Selection.Borders（xlDiagonalDown）.LineStyle=xlNonehOUNi。
WithSelection.Borders（xlInsideHorizontal）
去掉第三行的:
号
sTempString=Right（Cells（3,1）,Len（Cells（3,1））-3）GiwW2。
ActiveCell.FormulaR1C1=sTempString
i=2
j=1
外层循环判断是否都合并完成,这里插入了一行，加1
Whilei<
=cRows
i=i+1
Range（Cells（i+1,j）,Cells（i+1,j））.Select
去掉分类行中的:
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））.SelectxtwBS。
对第三行进行设定
Selection.RowHeight=18
合并前两格
先将其合并
.HorizontalAlignment=xlLeft'
靠左对齐
合并
对其设定字体风格
.Size=9
.colorIndex=3
.HorizontalAlignment=xlLeft
sTempString=Right（Cells（i+1,j）,Len（Cells（i+1,j））-3）OXPTP。
ActiveCell.FormulaR1C1=sTempString
EndIf
加1后判断是否到了表尾，没有继续合并处理
If（i<
=cRows+1）Then
rowIndex=i
取出Cells（i,j）的内容
sTempString=Cells（i,j）
循环判断下一个单元格是否和上一个单元格相等，不是则表示到此该合并
WhilesTempString=Cells（i+1,j）Andi<
Wend
设置第一列'
跳出循环表示已经到此该将rowIndex和i行合并
Range（Cells（rowIndex,j）,Cells（i,j））.Select
将原来内容填充进来
设合并后的单元格的边框
Selection.Font.FontStyle="
设置第一列结束'
设置第二列'
Range（Cells（rowIndex,j+1）,Cells（i,j+1））.SelectMex62。
设置字体
Selection.Borders（xlDiagonalDown）.LineStyle=xlNoneh7pGG。
.Weigh
升级会员 