我编写的VBA程序.doc

Sub删除空格()
Dimi%
Fori=1To10
Cells.ReplaceWhat:="",Replacement:="",LookAt:=xlPart,SearchOrder:=_
xlByRows,MatchCase:=False,MatchByte:=False
Nexti
EndSub

Sub删除工作簿中所有表中的空格()
Dimi%
DimjAsInteger
Forj=1ToWorksheets.Count
Worksheets(j).Select
Fori=1To10
Cells.ReplaceWhat:="",Replacement:="",LookAt:=xlPart,SearchOrder:=_
xlByRows,MatchCase:=False,MatchByte:=False
Nexti
Nextj
EndSub

Sub比较两列数据不同之处()
'
'比较两列数据不同之处Macro
'宏由罗艳军录制，时间:2009-9-18
'
DimhsAsInteger
DimiAsInteger
hs=Range("a65536").End(xlUp).Row
Fori=1Tohs
IfRange("A"&i).Value<>Range("B"&i).ValueThen
MsgBox"注意第"&i&"行数据不同"
ExitSub
EndIf
Nexti
MsgBox"现在两列数据完全相同"
EndSub

Sub在A列中查找B列没有的数据()
'宏由罗艳军录制，时间:2009-10-1
DimhsAsInteger
DimiAsInteger
hs=Range("a65536").End(xlUp).Row
Fori=1Tohs
'Debug.Printi
IfColumns("B").Find(Range("A"&i).Value)IsNothingThen
MsgBox"注意，没有"&"A"&i
ExitSub
Else
EndIf
Nexti
MsgBox"现在A列有的数据B列中全有了！"
EndSub

Sub合并两列数据()'使用本程序前，请把光标停在第二列的第一行
DoWhileActiveCell<>""'一直循环，直到活动单元格为空。
ActiveCell.Offset(0,1).FormulaR1C1=_
ActiveCell.Offset(0,-1)&ActiveCell.Offset(0,0)
ActiveCell.Offset(1,0).Select
Loop
EndSub

Sub区域兑换()
DimXRAsRange,YRAsRange
DimSZ1,SZ2,Down
IfSelection.Areas.Count=2Then
SetXR=Selection.Areas(1)
SetYR=Selection.Areas(2)
IfNotIntersect(XR,YR)IsNothingThen
Down=MsgBox("选择区域有重叠！"&vbCrLf&_
"对换后数据将有部份被覆盖！"&vbCrLf&_
"是否继续？",vbYesNo)
IfDown=vbNoThenExitSub
EndIf
IfXR.Rows.Count=YR.Rows.CountAndXR.Columns.Count=YR.Columns.CountThen
SZ1=XR.Formula
SZ2=YR.Formula
XR=SZ2
YR=SZ1
Else
MsgBox"选择的两个区域不相同！"
EndIf
Else
MsgBox"请选择二个相同的区域！"
EndIf
EndSub

Sub把A列中有而B列中没有的数据挑出来放在C列中()
'宏由罗艳军录制，时间:2010-8-26
DimhsAsInteger
DimiAsInteger
DimcAsInteger
c=1
hs=Range("a65536").End(xlUp).Row
Fori=1Tohs
'Debug.Printi
IfColumns("B").Find(Range("A"&i).Value)IsNothingThen
Range("c"&c).Value=Range("A"&i).Value
c=c+1
EndIf
Nexti
MsgBox"现在A列有的数据B列中全有了！"
EndSub
‘用数组分班
OptionBase1
SubMacro2()
'Macro2Macro
'宏由罗艳军录制，时间:2010-9-15
'初始化
DimxsrsAsInteger
xsrs=298
DimbjsAsInteger
Dimxssz(298,9)
bjs=6
'xssz=Sheet1.Range("A2:G299")

'工