Excel自编宏大全Word版.docx
- 文档编号:2929542
- 上传时间:2022-11-16
- 格式:DOCX
- 页数:82
- 大小:39.60KB
Excel自编宏大全Word版.docx
《Excel自编宏大全Word版.docx》由会员分享,可在线阅读,更多相关《Excel自编宏大全Word版.docx(82页珍藏版)》请在冰豆网上搜索。
Excel自编宏大全Word版
1,从数据源匹配取数的问题
2,部分字符地址查找
3,多表查询汇总和重复值问题(相同行删除、循环比较)
4,工作表的名称和index号
5,重复值加色
6,统计
7,最大或最小
8,最后一记录(定义动态区域名称、不重复值公式宏、不重复值个数和行数公式宏、加边框宏)
9,大港表格转换
10,筛选尾数
11,对比数据
12,修改批注字体
13,删除合并单元格
14,物品领用报表
15,条件格式设置
16,多表查询,自动筛选法
17,多条件查询累计汇总
18,和值
19,教师安排汇总(循环比较、不重复值)
20,自动着色(不同个数、不同颜色)
21,不重复值的个数及所在行的行数(各个值的个数、行数)
22,分表自动字体格式化
23,自动填充数字
24,导入文本文件
25,累计不变化(内部循环)
26,同结构多表统计汇总(Consolidate方法)
27,资产负债表汇总(多工作簿汇总)
28,导出到文本文件
29,角度求和的自定义公式
30,表单输入模板
31,两表间复制与核对
1,从数据源匹配取数的问题
Sub宏131()
'从数据源匹配取数的问题131.xls
'2007-1-31
'Shizx98
'
DimaAsRange,Myrng1AsRange,Myrng2AsRange
DimMyrowAsInteger
DimMyrow1AsInteger
DimMyrow2AsInteger
DimMyrow3AsInteger
DimxAsInteger
Worksheets("Sheet1").Activate
Range("d2").Select
Selection.CurrentRegion.Select
Myrow2=Selection.Rows.Count'D列数据的行数
Range("a1").Select
Myrow3=Selection.CurrentRegion.Rows.Count'AB列数据的行数
SetMyrng1=Range(Cells(2,1),Cells(Myrow3,1))
SetMyrng2=Range(Cells(2,2),Cells(Myrow3,2))
Forx=2ToMyrow2+1
Seta=Range("D"&x)
Fory=1ToMyrow3
IfLen(a)>7Then
Myrow=Application.WorksheetFunction.Match(a,Myrng1,0)
Else
Myrow=Application.WorksheetFunction.Match(a,Myrng2,0)
EndIf
IfMyrow=0Then
GoTo100
Else
Range("F1").Select
Selection.CurrentRegion.Select
Myrow1=Selection.Rows.Count
Range(Cells(Myrow+1,1),Cells(Myrow+1,2)).Select
Selection.CutDestination:
=Range(Cells(Myrow1+1,6),Cells(Myrow1+1,7))
Selection.DeleteShift:
=xlUp
Myrow=0
MsgBox"已找到!
"
GoTo200
EndIf
100:
Nexty
200:
Nextx
EndSub
2,部分字符地址查找
‘2007/1/30
‘部分字符地址查找.xls
Subbfzfcz()
DimMyrow1AsInteger
DimMyrow2AsInteger
Dimx%,y1%,y2%,gg%
DimAA,BB
OnErrorResumeNext
Range("a2").Select
Selection.CurrentRegion.Select
Myrow1=Selection.Rows.Count
Range("e1").Select
Selection.CurrentRegion.Select
Myrow2=Selection.Rows.Count
gg=2
Forx=2ToMyrow2
AA=Range("e"&x)
Fory1=2ToMyrow1+1
BB=Application.WorksheetFunction.SearchB(AA,Cells(y1,1))
IfBB>0Then
Range("g"&gg)="A"&y1
gg=gg+1
Else
EndIf
BB=0
Nexty1
Fory2=2ToMyrow1+1
BB=Application.WorksheetFunction.SearchB(AA,Cells(y2,2))
IfBB>0Then
Range("g"&gg)="B"&y2
gg=gg+1
Else
EndIf
BB=0
Nexty2
'gg=gg+1
Nextx
EndSub
3,多表查询汇总和重复值问题(相同行删除、循环比较)
Sub宏0204()
'
'见汇总0204.xls
'2007-2-4
'蓝桥玄霜
'大汇总问题
'
DimxAsInteger,yAsInteger
Dimrng1AsRange,tblAsRange
DimnAsInteger
DimMyrow1AsInteger,Myrow2AsInteger
Dimrng2
Application.ScreenUpdating=False
Sheets("汇总").Select'清除总表原有的数据
Range("a1").Select
Settbl=ActiveCell.CurrentRegion
Iftbl.Rows.Count>1Then
tbl.Offset(1,0).Resize(tbl.Rows.Count-1,tbl.Columns.Count).ClearContents
Else
EndIf
n=2
Sheets("使用型号表").Select
Range("a1").Select
Myrow1=[a65536].End(xlUp).Row'A列最下面一行的行数,中间有空格也行
Forx=2ToMyrow1
Sheets("使用型号表").Select
Setrng1=Range("B"&x)'依次把“使用数量”的值赋给rng1变量
rng2=Range("A"&x).Text'把序号里的表格名赋给rng2变量
Ifrng1.Value<>""Then
Sheets("汇总").Cells(1,6).Value=rng1.Value
Sheets(rng2).Select'用表格名选择表格
Range("a1").Select
Myrow2=Selection.CurrentRegion.Rows.Count'数据的行数
Range(Cells(2,2),Cells(Myrow2,5)).Copy'复制这些数据
Sheets("汇总").Activate
Cells(n,2).PasteSpecial'粘贴到汇总表
Range(Cells(n,6),Cells(Myrow2+n-2,6)).Select'选择F列相同行数
Selection.FormulaR1C1="=RC[-1]*r1c6"'将使用数量X数量
Range(Cells(n,6),Cells(Myrow2+n-2,6)).Copy'复制这些数据
Cells(n,5).Select
Selection.PasteSpecialPaste:
=xlValues
'以“选择性粘贴”的“数值”粘贴
Range(Cells(n,6),Cells(Myrow2+n-2,6)).ClearContents'清除F列数量
Cells(1,6).ClearContents
n=n+Myrow2-1'为下次粘贴数据的行位置
Else
EndIf
Nextx
bcfhz0204'不重复汇总的宏
Application.ScreenUpdating=True
EndSub
Subbcfhz0204()
'不重复汇总
'蓝桥玄霜
'2007-2-4
DimbAsInteger,xAsInteger,yAsInteger,aaAsInteger,yyyAsInteger
DimmincAsRange
Dimrng1AsRange,aAsRange
Dimn1AsInteger,nnAsInteger,Myrow1AsInteger
Dimpp,pp1
OnErrorResumeNext
Sheets("汇总").Select
Range("a1").Select
Myrow1=Selection.CurrentRegion.Rows.Count'A列数据的行数
Setminc=Range("b2:
b"&Myrow1)
Setrng1=Range("m2:
m"&Myrow1)
Range("m2").Select'求重复值个数的辅助列公式
Selection.Formula="=if((countif(minc,$b2)>1)*(match($b2,minc,0)=row($a1)),count(m$1:
m1)+1,"""")"
Selection.AutoFillDestination:
=rng1,Type:
=xlFillDefault'公式往下复制
b=Application.WorksheetFunction.Max(rng1)
Range("n2").Select'求重复值的辅助列公式
Selection.Formula="=if(iserror(index(minc,match(row(b1),m$2:
m$65536,0))),"""",index(minc,match(row(b1),m$2:
m$65536,0)))"
Selection.AutoFillDestination:
=Range("n2:
n"&b+1),Type:
=xlFillDefault'公式往下复制
Range("n2:
n"&b+1).Select
'以“选择性粘贴”的“数值”粘贴n,m列,因为删除一行后,公式会重新计算'
Selection.Copy
Range("n2").Select
Selection.Paste
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- Excel 宏大 Word