Excel VBA编程实例Word文件下载.docx

Excel VBA编程实例Word文件下载.docx

《Excel VBA编程实例Word文件下载.docx》由会员分享，可在线阅读，更多相关《Excel VBA编程实例Word文件下载.docx（23页珍藏版）》请在冰豆网上搜索。

DimTABLENAMEAsString'

待处理的表名

DimcolorIndexAsString'

颜色索引名字

HEADERCOLORINDEX=15

colorIndex=36'

颜色从33开场是比拟浅的颜色

TABLENAME="

direct_Price"

关闭所有弹出的警告消息

Application.DisplayAlerts=False

设置需要处理的单元表

Sheets（TABLENAME）.Select

'

取单元表的总列数与总行数

选择所有的单元格

Range（Cells（1,1）,Cells（cRows,cColumns））.Select

设置所有的边框

Selection.Borders（xlDiagonalDown）.LineStyle=xlNone

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

向表头添加一行

Rows（"

1:

1"

Columns（"

A:

A"

B:

B"

D:

D"

E:

E"

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）.Font

.Name="

Arial"

.FontStyle="

加粗倾斜"

.Size=10

.Strikethrough=False

.Superscript=False

.Subscript=False

.OutlineFont=False

.Shadow=False

.Underline=xlUnderlineStyleNone

.colorIndex=2

单元格设定边框

Selection.Borders（xlEdgeTop）.LineStyle=xlNone

.colorIndex=56

Selection.Borders（xlInsideHorizontal）.LineStyle=xlNone

.colorIndex=5

.Pattern=xlSolid

.PatternColorIndex=xlAutomatic

设定头两行的内部款式'

B1:

B2"

C1:

C2"

D1:

D2"

加粗"

.Size=8

.WrapText=True

.colorIndex=HEADERCOLORINDEX

Type"

=4）.Font

E1:

F1"

E2:

F2"

.MergeCells=False

加第一二行边框

WithSelection.Borders（xlInsideHorizontal）

去掉第三行的:

号

sTempString=Right（Cells（3,1）,Len（Cells（3,1））-3）

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））.Select

对第三行进展设定

Selection.RowHeight=18

合并前两格

先将其合并

.HorizontalAlignment=xlLeft'

靠左对齐

合并

对其设定字体风格

WithSe

.Size=9

.colorIndex=3

.HorizontalAlignment=xlLeft

sTempString=Right（Cells（i+1,j）,Len（Cells（i+1,j））-3）

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））.Select

设置字体

设置第二列完毕'

修改原来单元格的数据格式'

首先向任一无用的单元格写入数据

Range（Cells（cRows+2,cColumns）,Cells（cRows+2,cColumns））.Select

将其格式拷贝

复制格式

Range（Cells（rowIndex,j+4）,Cells（i,cColumns））.Select

Selection.PasteSpecialPaste:

=xlPasteAll,Operation:

=xlMultiply,_

SkipBlanks:

=False,Transpose:

=False

Selection.NumberFormatLocal="

_*#,##0.00000"

去除原来内容

设定数据格式完成'

统一设置该区域的颜色