超好用-宏的标准程序块_第1页
超好用-宏的标准程序块_第2页
超好用-宏的标准程序块_第3页
超好用-宏的标准程序块_第4页
超好用-宏的标准程序块_第5页
已阅读5页,还剩11页未读 继续免费阅读

下载本文档

版权说明:本文档由用户提供并上传,收益归属内容提供方,若内容存在侵权,请进行举报或认领

文档简介

1、sub 重新命名工作表() sheets("sheet1").name="标准件计划"'选中sheet1文件簿,命名为“标准件计划”end subsub 新建工作表并命名()="标准件计划"'新建文件簿,命名为“标准件计划”end subsub 新建工作表自动命名()sheets.add'新建文件簿,自动命名end subsub 插入行()rows("1:1").select'选中第一行selection.insert shift:=xldown'

2、;插入行end subsub 插入列()selection.insert shift:=xltoright'插入列end subsub 选中列()columns("g:g")'选中"g:g"列,注:需更改列数end subsub 选中工作表()sheets("标准件计划").select'选中文件簿,注:需更改文件簿名称end subsub 选中单元格()range("A2").select'选中单元格,注:需更改单元格end subsub 选中单元格区域()range("

3、A2:C20").select'选中单元格,注:需更改单元格end subsub 选中单元格并赋值()range("A2").select'选中单元格,注:需更改单元格Activecell.formular1c1="序号"'激活单元格,并赋值end subsub 选择性粘贴()range("A2").select'1、选中单元格,注:需更改单元格selection.copy'复制选中的对象range("A3").select'1、选中单元格,注:需更改单元格

4、selection.pasteSpecial Paste:=xlpasteValues,operation:=xlNone,SkipBlanks _:=False,Transpose:=False'选择性粘贴,注:此处“ _”为换行符号,为空格+_end subsub 粘贴()Cells.select'选中所有单元格,注:需更改单元格selection.copy'复制选中的对象sheets("标准件计划").select'选中文件簿,注:需更改文件簿名称Cells.select'选中所有单元格,注:需更改单元格Activesheet.

5、paste'粘贴end subsub 删除选中列()columns("A:F").AdvancedFilter Action:=xlFilterCopy, criteriaRange:=Sheets( _"条件区").Rows("1:2"), CopyToRange:=Range("G1"), Unique:=False'"A:F"中数据 _按"条件区"中"1:2"行条件进行高级筛选,筛选后的数据粘贴在单元格"G1"起的

6、数据区 _内。注:1、"A:F"数据区中1行应有分项名,如“日期”、“品名”“单价”等,同理 _"1:2"条件区1行也应有分项名。2、此处"条件区"为可变,以实际应用的文件簿为准。 _3、此处"G1"为可变量,具体以放在哪里合适为准,应该是"A:F"以后列。4、此处 _columns("A:F")、Rows("1:2")都可以为单元格。columns("A:F").Select'选中A至F列selection.Delete Sh

7、ift:=xlToLeft'删除选中列end subsub 单元格内字各个符颜色和格式()range("A1").select'选中单元格“A1”with activecell.characters(start:=1,length:=4).Font'激活单元格的字体特性 _(第1个字符开始,长度为4个;1和4是变量).name ="仿宋_GB2312"'字体名字.fontstyle ="加粗"'字体风格.size =9'字体大小.strikethrough =false'删除线.

8、superscript =false'上标.outlineFont =false'字体外形.shadow =false'字体外形.underline =xlUnderlineStyleNone'无下划线.ColorIndex =xlAutomatic'颜色为自动end with'以。结束end subsub macr16()for i =1 to 10'i为1至10cells(i,i).value =i'单元格(i,i)的值等于inext i'下一个i值循环end subsub macr17()for i =2 to 10

9、'i为2至10 if cells(i,6).value > 0 then'如果单元格(i,6)的值大于0,那么 cells(i,8).value = "service revenue"'单元格(i,8)的赋值为“维修收入” cells(i,1).resize(1,8).interior.colorindex = 4'单元格(i,1),单元格调 _整到“第1至第8格”,颜色外壳(单元格底色)=4(绿色)。(其中cells(i,1)的 _1作为单元格列数起点,resize(1,8)中的1受前面到限制。)end if'终止如果函数ne

10、xt i'下一个i值循环end subsub macr18()finalrow = cells(65536,1).end(xlup).row'最后行等于A列单元格不是空白为止, _实际运用中A列一般为序号,那么就是有序号到行才是有效到数据集,才进行以下运算。for i =2 to finalrow'i为2至finalrow,“finalrow”为变量 if cells(i,6).value > 0 then'如果单元格(i,6)的值大于0,那么 cells(i,8).value = "service revenue"'单元格(i

11、,8)的赋值为“维修收入” cells(i,1).resize(1,8).interior.colorindex = 4'单元格(i,1),单元格调 _整到“第1至第8格”,颜色外壳(单元格底色)=4(绿色)。(其中cells(i,1)的 _1作为单元格列数起点,resize(1,8)中的1受前面到限制。)end if'终止如果函数next i'下一个i值循环end subsub 变量选择多行数据()finalrow = cells(65536,1).end(xlup).row'最后行等于A列单元格不是空白为止, _实际运用中A列一般为序号,那么就是有序号到行才

12、是有效到数据集,才进行以下运算。 i =finalrow'ifinalrow,“finalrow”为变量 range(cells(1,1),cells(i,256).select'选中所有数据selection.cut'剪切选中所有数据end subsub macr19()finalrow = cells(65536,1).end(xlup).row'最后行等于A列单元格不是空白为止, _实际运用中A列一般为序号,那么就是有序号的行才是有效到数据集,才进行以下运算。 for i =2 to finalrow step 2'i为2至finalrow,“fi

13、nalrow”为变量,“step 2" _幅度为2(每两个计算一次,“2”可以为任意值)。 cells(i,1).resize(1,8).interior.colorindex = 4'单元格(i,1),单元格调 _整到“第1至第8格”,颜色外壳(单元格底色)=4(绿色)。(其中cells(i,1)的 _1作为单元格列数起点,resize(1,8)中的1受前面到限制。)next i'下一个i值循环end subsub 删除符合条件的行()finalrow = cells(65536,1).end(xlup).row'最后行等于A列单元格不是空白为止, _实际运

14、用中A列一般为序号,那么就是有序号的行才是有效到数据集,才进行以下运算。 for i =finalrow to 2 step -1'i为2至finalrow,“finalrow”为变量,“step -1" _幅度为1(让For.Next循环从高向低运行)。if cells(i,1).value > 0 then'如果单元格(i,1)大于0那么 cells(i,1).Entirerow.Copy'单元格(i,1)整个行复制 sheets("费用总计表").select rows("1:1").select'选

15、中1行 selection.insert shift:=xldown'插入复制单元格 Wsd.select'选中文件簿1 end ifnext i'下一个i值循环end subsub macr23()Dim k As integer'定义k为整数类型for k=1 to 137'定义k为1至137worksheets(k).select'选中文件簿kfinalrow = cells(65536,1).end(xlup).row'最后行等于A列单元格不是空白为止, _实际运用中A列一般为序号,那么就是有序号的行才是有效到数据集,才进行以下运

16、算。 for i =finalrow to 2 step -1'i为2至finalrow,“finalrow”为变量,“step -1" _幅度为1(让For.Next循环从高向低运行)。 if cells(i,1).value > 0 then'如果单元格(i,1)大于0那么 cells(i,1).Entirerow.Copy'单元格(i,1)整个行复制 sheets("费用总计表").select rows("1:1").select'选中1行 selection.insert shift:=xldow

17、n'插入复制单元格 worksheets(k).select'选中文件簿k end if next i'下一个i值循环 next k'下一个k值循环end subsub macr24()'使用If.Then.Else.End Iffinalrow = cells(65536,1).end(xlup).row'最后行等于A列单元格不是空白为止, _实际运用中A列一般为序号,那么就是有序号的行才是有效到数据集,才进行以下运算。 for i = 2 to finalrow if cells(i,1).value = "及格" the

18、n'如果单元格(i,1)等于"及格"那么 cells(i,1).resize(1,3).font.colorindex = 4'单元格(i,1),单元格调 _整到“第1至第3格”,字体颜色=4(绿色)。(其中cells(i,1)的1作为单元格列数起 _点,resize(1,3)中的1受前面到限制。) Else cells(i,1).resize(1,3).font.colorindex = 50'单元格(i,1),单元格调 _整到“第1至第3格”,字体颜色=50(绿色)。(其中cells(i,1)的1作为单元格列数起 _点,resize(1,3)中的

19、1受前面到限制。) end ifnext i'下一个i值循环end subsub macr25()'使用If.Else IF.Else IF.Else.End Iffinalrow = cells(65536,1).end(xlup).row'最后行等于A列单元格不是空白为止, _实际运用中A列一般为序号,那么就是有序号的行才是有效到数据集,才进行以下运算。 for i = 2 to finalrow if cells(i,1).value = "及格" then'如果单元格(i,1)等于"及格"那么 cells(i,1)

20、.resize(1,3).font.colorindex = 3'单元格(i,1),单元格调 _整到“第1至第3格”,字体颜色=3。(其中cells(i,1)的1作为单元格列数起 _点,resize(1,3)中的1受前面到限制。) Elseif cells(i,1).value = "不及格" then'如果单元格(i,1)等于"及格"那么 cells(i,1).resize(1,3).font.colorindex = 50'单元格(i,1),单元格调 _整到“第1至第3格”,字体颜色=50。(其中cells(i,1)的1作为单

21、元格列数起 _点,resize(1,3)中的1受前面到限制。) Elseif cells(i,1).value = "优秀" then'如果单元格(i,1)等于"及格"那么 cells(i,1).resize(1,3).font.colorindex = 5'单元格(i,1),单元格调 _整到“第1至第3格”,字体颜色=5。(其中cells(i,1)的1作为单元格列数起 _点,resize(1,3)中的1受前面到限制。) Elsecells(i,1).resize(1,3).font.colorindex = 6'单元格(i,1)

22、,单元格调 _整到“第1至第3格”,字体颜色=50(绿色)。(其中cells(i,1)的1作为单元格列数起 _点,resize(1,3)中的1受前面到限制。) end ifnext i'下一个i值循环end sub sub macr26()range("b2:cv100").formular1c1 = "=rc1*r1c"'乘法表,A1、B1、C1.乘以1A、 _2A、3A、.end subFunction 指定名字 () As String'设置用户自定义函数“指定名字”,指定单元格内 _容为该单元格所在文件簿的名字。注:使用时

23、直接到用户自定义函数中提出。注:函数 _名字都中英皆可。 指定名字 = thisworkbook.Nameend Function Function 指定路径 () As String'设置用户自定义函数“指定路径”,指定单元格内 _容为该单元格所在文件簿的名字。注:使用时直接到用户自定义函数中提出。注:函数 _名字都中英皆可。 指定路径 = thisworkbook.FullNameend Function Function 上次保存时间 (文件路径 As String) As Date'设置用户自定义函数“上次 _保存时间”,参数为文件路径。注:函数名字都中英皆可。 上次保

24、存时间 = FileDateTime(文件路径)end Function Function 现在时间'设置设置文件当前时间,不手动更新返回单元格的话,会不变化 _设置时间。注:函数名字都中英皆可。 现在时间 = Nowend FunctionSub 合并内容相同的连续单元格() Dim IntRow As Integer Dim i As Integer Application.DisplayAlerts = False With Sheet1 IntRow = .Range("A65536").End(xlUp).Row For i = IntRow To 2 S

25、tep -1 If .Cells(i, 2).Value = .Cells(i - 1, 2).Value Then .Range(.Cells(i - 1, 2), .Cells(i, 2).Merge End If Next End With Application.DisplayAlerts = True End Sub'解析:第7行到第11行代码,从最后一行开始,向上逐个单元格判断连续两 _个单元格的内容是否相同,如果相同则合并。运行Mergerng过程后,结果如图所示。Sub 取消合并单元格时在每个单元格中保留内容() Dim StrMer As String Dim Int

26、Cot As Integer Dim i As Integer With Sheet1 For i = 2 To .Range("B65536").End(xlUp).Row StrMer = .Cells(i, 2).Value IntCot = .Cells(i, 2).MergeArea.Count .Cells(i, 2).UnMerge .Range(.Cells(i, 2), .Cells(i + IntCot - 1, 2).Value = StrMer i = i + IntCot - 1 Next End With End Sub'解析:UnMer

27、ge过程取消工作表中B列中的合并单元格,并且各个单元格均保留 _原合并单元格的内容。第7行代码取得B列每个合并单元格的内容。第8行代码取得合并区 _域的单元格数量。第9行代码使用UnMerge方法取消合并单元格。UnMerge方法将合并区域 _分解为独立的单元格,语法如下:expression.UnMerge第10行代码将原合并单元格的内容 _赋值给取消合并单元格后的区域。第11行代码调整循环变量i的值,使下一次循环从下一 _个单元格区域开始。Sub 预算表头()Dim i As IntegerDim k As Integeri = ActiveCell.Row '获取单元格区域Rng

28、左上角单元格所在行编号k = ActiveCell.Column '获取单元格区域Rng左上角单元格所在列编号Cells(i, k).FormulaR1C1 = "序号" '激活单元格,并赋值Cells(i, k + 1).FormulaR1C1 = "名称" '激活单元格,并赋值Cells(i, k + 2).FormulaR1C1 = "型号" '激活单元格,并赋值Cells(i, k + 3).FormulaR1C1 = "单位" '激活单元格,并赋值Cells(i,

29、k + 4).FormulaR1C1 = "数量" '激活单元格,并赋值Cells(i, k + 5).FormulaR1C1 = "单价" '激活单元格,并赋值Cells(i, k + 6).FormulaR1C1 = "单重" '激活单元格,并赋值Cells(i, k + 7).FormulaR1C1 = "总价" '激活单元格,并赋值Cells(i, k + 8).FormulaR1C1 = "总价" '激活单元格,并赋值Cells(i, k + 9

30、).FormulaR1C1 = "备注" '激活单元格,并赋值Range(Cells(i, k), Cells(i, k + 9).Select '选中单元格With Selection.Font '单元格字体.Name = "宋体".Size = 12.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.ColorIndex =

31、 xlAutomaticEnd WithWith Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlBottom.WrapText = False.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd WithSelection.Font.Bold = TrueSelection.Font.ColorIndex = 41 '单元格字体

32、颜色End SubSub 合并内容相同的连续单元格()Dim IntRow As IntegerDim i As IntegerDim k As IntegerApplication.DisplayAlerts = Falsek = ActiveCell.Column '获取单元格区域Rng左上角单元格所在列编号With ActiveSheet '此处不是很懂,好像没什么用处,原来是sheet1也可以使用!IntRow = .Cells(65536, k).End(xlUp).Row '提取最后一行行号,也可用.Range("A65536")For

33、i = IntRow To 2 Step -1If .Cells(i, k).Value = .Cells(i - 1, k).Value Then.Range(.Cells(i - 1, k), .Cells(i, k).MergeEnd IfNextEnd WithApplication.DisplayAlerts = TrueEnd Sub '解析:第7行到第11行代码,从最后一行开始,向上逐个单元格判断连续两 _个单元格的内容是否相同,如果相同则合并。运行Mergerng过程后,结果如图所示。Sub 取消合并单元格时在每个单元格中保留内容()Dim StrMer As Stri

34、ngDim IntCot As IntegerDim i As IntegerDim k As Integerk = ActiveCell.Column '获取单元格区域Rng左上角单元格所在列编号With ActiveSheet '此处不是很懂,好像没什么用处,原来是sheet1也可以使用!For i = 2 To .Cells(65536, k).End(xlUp).Row '提取最后一行行号,也可用.Range("A65536")StrMer = .Cells(i, k).ValueIntCot = .Cells(i, k).MergeArea

35、.Count.Cells(i, k).UnMerge.Range(.Cells(i, k), .Cells(i + IntCot - 1, k).Value = StrMeri = i + IntCot - 1NextEnd WithEnd Sub '解析:UnMerge过程取消工作表中B列中的合并单元格,并且各个单元格均保留 _原合并单元格的内容。第7行代码取得B列每个合并单元格的内容。第8行代码取得合并区 _域的单元格数量。第9行代码使用UnMerge方法取消合并单元格。UnMerge方法将合并区域 _分解为独立的单元格,语法如下:expression.UnMerge第10行代码将

36、原合并单元格的内容 _赋值给取消合并单元格后的区域。第11行代码调整循环变量i的值,使下一次循环从下一 _个单元格区域开始。Sub 合并单元格时连接每个单元格()Dim StrMerge As StringDim rng As RangeIf TypeName(Selection) = "Range" ThenFor Each rng In SelectionStrMerge = StrMerge & rng.ValueNextApplication.DisplayAlerts = FalseSelection.MergeSelection.Value = StrM

37、ergeApplication.DisplayAlerts = TrueEnd IfEnd Sub '解析:Mergerng过程将所选各个单元格的内容连接起来保存在合并后的单元格区域中? _第4行代码使用TypeName函数判断当前选定对象是否为Range对象,若是则继续执行代码。 _第5行到第7行代码将当前选中区域的内容连接起来保存在字符串变量StrMerge中? _第8行代码将DisplayAlerts属性设置为False,禁止在合并多重数值区域时,Excel显示的 _警告信息,避免中断代码的运行。 _第9行代码使用Merge方法合并当前选定区域。应用于Range对象的Merge方

38、法通过指定Range _对象创建合并单元格,语法如下: _expression.Merge (Across)参数expression是必需的,返回一个Range对象。参数Across是可选 _的,如果该值为True,则将指定区域内的每一行合并为一个合并单元格。默认值为False。 _第9行也可以使用下面的代码:Selection.MergeCells = True _第10行代码将变量StrMerge的值赋给合并后的单元格? _运行Mergerng过程结果如图所示?Sub 预算表头()Dim i As IntegerDim k As Integeri = ActiveCell.Row '

39、;获取单元格区域Rng左上角单元格所在行编号k = ActiveCell.Column '获取单元格区域Rng左上角单元格所在列编号Cells(i, k).FormulaR1C1 = "序号" '激活单元格,并赋值Cells(i, k + 1).FormulaR1C1 = "名称" '激活单元格,并赋值Cells(i, k + 2).FormulaR1C1 = "型号" '激活单元格,并赋值Cells(i, k + 3).FormulaR1C1 = "单位" '激活单元格,并

40、赋值Cells(i, k + 4).FormulaR1C1 = "数量" '激活单元格,并赋值Cells(i, k + 5).FormulaR1C1 = "单价" '激活单元格,并赋值Cells(i, k + 6).FormulaR1C1 = "单重" '激活单元格,并赋值Cells(i, k + 7).FormulaR1C1 = "总价" '激活单元格,并赋值Cells(i, k + 8).FormulaR1C1 = "总价" '激活单元格,并赋值Cel

41、ls(i, k + 9).FormulaR1C1 = "备注" '激活单元格,并赋值Range(Cells(i, k), Cells(i, k + 9).Select '选中单元格With Selection.Font '单元格字体.Name = "宋体"模块1 - 2.Size = 12.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyl

42、eNone.ColorIndex = xlAutomaticEnd WithWith Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlBottom.WrapText = False.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd WithSelection.Font.Bold = TrueSelection.Font.ColorInd

43、ex = 5 '单元格字体颜色End SubSub 定义价格系数()Dim i As IntegerDim k As Integeri = 1 '获取单元格区域Rng左上角单元格所在行编号k = 1 '获取单元格区域Rng左上角单元格所在列编号Range(Cells(i, 1), Cells(i + 2, 256).Select '选中第一行Selection.Insert shift:=xlDown '插入行Cells(i, k).FormulaR1C1 = "品名" '激活单元格,并赋值Cells(i + 1, k).Fo

44、rmulaR1C1 = "简写" '激活单元格,并赋值Cells(i + 2, k).FormulaR1C1 = "系数" '激活单元格,并赋值Cells(i, k + 1).FormulaR1C1 = "电机座" '激活单元格,并赋值Cells(i + 1, k + 1).FormulaR1C1 = "AA" '激活单元格,并赋值Cells(i + 2, k + 1).FormulaR1C1 = "6.25" '激活单元格,并赋值ActiveWorkbo

45、ok.Names.Add Name:="AA", RefersToR1C1:="=R3C2" '此处R3C2不是很懂,为什么不能用相对,而用绝对值之后,实际上却是相对的,即选中B4Cells(i, k + 2).FormulaR1C1 = "一般铆焊件" '激活单元格,并赋值Cells(i + 1, k + 2).FormulaR1C1 = "BB" '激活单元格,并赋值Cells(i + 2, k + 2).FormulaR1C1 = "6.39" '激活单元格

46、,并赋值ActiveWorkbook.Names.Add Name:="BB", RefersToR1C1:="=R3C3"Cells(i, k + 3).FormulaR1C1 = "复杂铆焊件" '激活单元格,并赋值Cells(i + 1, k + 3).FormulaR1C1 = "CC" '激活单元格,并赋值Cells(i + 2, k + 3).FormulaR1C1 = "7.51" '激活单元格,并赋值ActiveWorkbook.Names.Add Nam

47、e:="CC", RefersToR1C1:="=R3C4"Cells(i, k + 4).FormulaR1C1 = "机加工件" '激活单元格,并赋值Cells(i + 1, k + 4).FormulaR1C1 = "DD" '激活单元格,并赋值Cells(i + 2, k + 4).FormulaR1C1 = "7.51" '激活单元格,并赋值ActiveWorkbook.Names.Add Name:="DD", RefersToR1C1:=

48、"=R3C5"Cells(i, k + 5).FormulaR1C1 = "备用9" '激活单元格,并赋值Cells(i + 1, k + 5).FormulaR1C1 = "EE" '激活单元格,并赋值Cells(i + 2, k + 5).FormulaR1C1 = "7.51" '激活单元格,并赋值ActiveWorkbook.Names.Add Name:="EE", RefersToR1C1:="=R3C26"Cells(i, k + 6).

49、FormulaR1C1 = "备用8" '激活单元格,并赋值Cells(i + 1, k + 6).FormulaR1C1 = "FF" '激活单元格,并赋值Cells(i + 2, k + 6).FormulaR1C1 = "7.51" '激活单元格,并赋值ActiveWorkbook.Names.Add Name:="FF", RefersToR1C1:="=R3C7"Cells(i, k + 7).FormulaR1C1 = "备用7" '

50、;激活单元格,并赋值Cells(i + 1, k + 7).FormulaR1C1 = "GG" '激活单元格,并赋值Cells(i + 2, k + 7).FormulaR1C1 = "7.51" '激活单元格,并赋值ActiveWorkbook.Names.Add Name:="GG", RefersToR1C1:="=R3C8"Cells(i, k + 8).FormulaR1C1 = "备用6" '激活单元格,并赋值Cells(i + 1, k + 8).Form

51、ulaR1C1 = "HH" '激活单元格,并赋值Cells(i + 2, k + 8).FormulaR1C1 = "7.51" '激活单元格,并赋值ActiveWorkbook.Names.Add Name:="HH", RefersToR1C1:="=R3C9"Cells(i, k + 9).FormulaR1C1 = "备用5" '激活单元格,并赋值Cells(i + 1, k + 9).FormulaR1C1 = "II" '激活单元

52、格,并赋值Cells(i + 2, k + 9).FormulaR1C1 = "7.51" '激活单元格,并赋值ActiveWorkbook.Names.Add Name:="II", RefersToR1C1:="=R3C10"Cells(i, k + 10).FormulaR1C1 = "备用4" '激活单元格,并赋值Cells(i + 1, k + 10).FormulaR1C1 = "JJ" '激活单元格,并赋值Cells(i + 2, k + 10).Formu

53、laR1C1 = "7.51" '激活单元格,并赋值ActiveWorkbook.Names.Add Name:="JJ", RefersToR1C1:="=R3C11"Cells(i, k + 11).FormulaR1C1 = "备用3" '激活单元格,并赋值Cells(i + 1, k + 11).FormulaR1C1 = "KK" '激活单元格,并赋值Cells(i + 2, k + 11).FormulaR1C1 = "7.51" '

54、;激活单元格,并赋值ActiveWorkbook.Names.Add Name:="KK", RefersToR1C1:="=R3C12"Cells(i, k + 12).FormulaR1C1 = "备用2" '激活单元格,并赋值Cells(i + 1, k + 12).FormulaR1C1 = "LL" '激活单元格,并赋值Cells(i + 2, k + 12).FormulaR1C1 = "7.51" '激活单元格,并赋值ActiveWorkbook.Names

55、.Add Name:="LL", RefersToR1C1:="=R3C13"Cells(i, k + 13).FormulaR1C1 = "备用1" '激活单元格,并赋值Cells(i + 1, k + 13).FormulaR1C1 = "MM" '激活单元格,并赋值Cells(i + 2, k + 13).FormulaR1C1 = "7.51" '激活单元格,并赋值ActiveWorkbook.Names.Add Name:="MM", Ref

56、ersToR1C1:="=R3C14"Range(Cells(i, k), Cells(i + 2, k + 13).Select '选中单元格With Selection.Font '单元格字体.Name = "宋体".Size = 10.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.ColorIndex = xlAutomati

57、cEnd WithWith Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlBottom.WrapText = False.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd WithWith Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous.Weight = xlThin.Co

58、lorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeTop).LineStyle = xlContinuous.Weight = xlThin.ColorIndex = xlAutomatic模块1 - 4End WithWith Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous.Weight = xlThin.ColorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeRight).LineStyle

59、= xlContinuous.Weight = xlThin.ColorIndex = xlAutomaticEnd WithWith Selection.Borders(xlInsideVertical).LineStyle = xlContinuous.Weight = xlThin.ColorIndex = xlAutomaticEnd WithWith Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous.Weight = xlThin.ColorIndex = xlAutomaticEnd WithSelecti

60、on.Font.Bold = TrueSelection.Font.ColorIndex = 5 '单元格字体颜色End SubSub 预算统计表头()Dim i As IntegerDim k As Integeri = ActiveCell.Row '获取单元格区域Rng左上角单元格所在行编号k = ActiveCell.Column '获取单元格区域Rng左上角单元格所在列编号Range(Cells(i, 1), Cells(i + 10, 256).Select '选中第一行Selection.Insert shift:=xlDown '插入行C

61、ells(i, k).FormulaR1C1 = "机械部分" '激活单元格,并赋值Cells(i + 1, k).FormulaR1C1 = "电器总计" '激活单元格,并赋值Cells(i + 2, k).FormulaR1C1 = "机+电" '激活单元格,并赋值Cells(i + 3, k).FormulaR1C1 = "运费总计" '激活单元格,并赋值Cells(i + 4, k).FormulaR1C1 = "安装总计" '激活单元格,并赋值C

62、ells(i + 5, k).FormulaR1C1 = "不可预见费" '激活单元格,并赋值Cells(i + 6, k).FormulaR1C1 = "现场水电费" '激活单元格,并赋值Cells(i + 7, k).FormulaR1C1 = "葫芦报检费" '激活单元格,并赋值Cells(i + 8, k).FormulaR1C1 = "中标服务费" '激活单元格,并赋值Cells(i + 9, k).FormulaR1C1 = "跟产费用" '激活单元格,并赋值Cells(i + 10, k).FormulaR1C1 = "总 计" '激活单元格,并赋值Cells(i, k + 1).FormulaR1C1 = "0" '激活单元格,并赋值Cells(i + 1, k + 1).FormulaR1C1 = "0" '激活单元格,并赋值Cells(i + 2, k + 1).FormulaR1C1 =

温馨提示

  • 1. 本站所有资源如无特殊说明,都需要本地电脑安装OFFICE2007和PDF阅读器。图纸软件为CAD,CAXA,PROE,UG,SolidWorks等.压缩文件请下载最新的WinRAR软件解压。
  • 2. 本站的文档不包含任何第三方提供的附件图纸等,如果需要附件,请联系上传者。文件的所有权益归上传用户所有。
  • 3. 本站RAR压缩包中若带图纸,网页内容里面会有图纸预览,若没有图纸预览就没有图纸。
  • 4. 未经权益所有人同意不得将文件中的内容挪作商业或盈利用途。
  • 5. 人人文库网仅提供信息存储空间,仅对用户上传内容的表现方式做保护处理,对用户上传分享的文档内容本身不做任何修改或编辑,并不能对任何下载内容负责。
  • 6. 下载文件中如有侵权或不适当内容,请与我们联系,我们立即纠正。
  • 7. 本站不保证下载资源的准确性、安全性和完整性, 同时也不承担用户因使用这些下载资源对自己和他人造成任何形式的伤害或损失。

评论

0/150

提交评论