excel&使用宏合并多个excel文件
Sub butten()
&& Dim myPath$, myFile$, AK As
Workbook, aRow%, tRow%, i As Integer
&& Application.ScreenUpdating =
&& myPath = ThisWorkbook.Path
& "\sheets\"
&& myFile = Dir(myPath &
&& Do While myFile &&
If myFile && ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile)
For i = 1 To AK.Sheets.Count
aRow = AK.Sheets(i).Range("a65536").End(xlUp).Row
tRow = ThisWorkbook.Sheets(1).Range("a65536").End(xlUp).Row +
AK.Sheets(i).Range("a2:k" & aRow).Copy
ThisWorkbook.Sheets(1).Range("a" & tRow)
Workbooks(myFile).Close False
myFile = Dir
&& Application.ScreenUpdating =
&& MsgBox ") ", 64,
已投稿到：
以上网友发言只代表其个人观点，不代表新浪网的观点或立场。sp=0；EndIf；st=InputBox(&各表从第几行；Ifst=&&Then；st=2；EndIf；Sheets(1).Select；Sheets.Add；Ifst&1Then；Sheets(2).Select；Rows(&1:&&；Selection.Copy；Sheets(1).Se
st = InputBox(&各表从第几行开始合并？不输则默认为2&)
If st = && Then
Sheets(1).Select
Sheets.Add
If st & 1 Then
Sheets(2).Select
Rows(&1:& & CStr(st - 1)).Select
Selection.Copy
Sheets(1).Select
Range(&A1&).Select
ActiveSheet.Paste
y = st - 1
For i = 2 To Sheets.Count
Sheets(i).Select
For v = 1 To 256
zd = Cells(65535, v).End(xlUp).Row
If zd & x Then
If y + x - st + 1 + sp & 65536 Then
MsgBox &内容太多，仅合并前& & i - 2 & &个表的内容，请把其它表复制到新工作薄里再用此程序合并！
Rows(st & &:& & x).Select
Selection.Copy
Sheets(1).Select
Range(&A& & CStr(y + 1)).Select
ActiveSheet.Paste
Sheets(i).Select
Range(&A1&).Select
'取消单元格被全选状态。
Application.CutCopyMode = False
'忘掉复制的内容。
y = y + x - st + 1 + sp
Sheets(1).Select
Range(&A1&).Select
'光标移至A1。
MsgBox &这就是合并后的表，请命名！&
▲合并指定目录中所有文件中相同格式工作表的数据
Sub 合并数据()
'合并指定目录中所有文件中相同格式工作表的数据
'见http://club.excelhome.net/dispbbs.asp?boardid=1&replyid=900613&id=249319&page=1&sk
Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
Application.ScreenUpdating = False
'冻结屏幕，以防屏幕抖动
myPath = ThisWorkbook.Path & &\分表\&
'把文件路径定义给变量
myFile = Dir(myPath & &*.xls&)
'依次找寻指定路径中的*.xls文件
Do While myFile && &&
'当指定路径中有文件时进行循环
If myFile && ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile)
'打开符合要求的文件
For i = 1 To AK.Sheets.Count
aRow = AK.Sheets(i).Range(&a65536&).End(xlUp).Row
tRow = ThisWorkbook.Sheets(1).Range(&a65536&).End(xlUp).Row + 1
'AK.Sheets(i).Select
AK.Sheets(i).Range(&a3:k& & aRow).Copy ThisWorkbook.Sheets(1).Range(&a& & tRow)
Workbooks(myFile).Close False
'关闭源工作簿,并不作修改
myFile = Dir
'找寻下一个*.xls文件
Application.ScreenUpdating = True
'冻结屏幕,此类语句一般成对使用
MsgBox &汇总完成，请查看！&, 64, &提示&
▲隐藏指定工作表的指定列
Sub 隐藏指定工作表的指定列()
Sheet1.Columns(&B:B&).EntireColumn.Hidden = True
▲把a列不重复值取到e列
Sub 把a列不重复值取到e列()
[A:A].AdvancedFilter 2, , [e1], 1
▲当前选区的行列数
Sub 当前选区的行列数()
Range(&A1&) = Selection.Rows.Count
'当前选区的行数
Range(&B1&) = Selection.Columns.Count
'当前选区的列数
▲单元格录入1位字符就跳转(工作表代码)
Private Sub TextBox1_Change()
If Len(Me.TextBox1.Text) && 1 Then Exit Sub
Me.TextBox1.Activate
ActiveCell = Me.TextBox1.Text
Me.TextBox1.Text = &&
ActiveCell.Activate
Application.SendKeys &~&
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With TextBox1
.Left = ActiveCell.Left
.Top = ActiveCell.Top
.Width = ActiveCell.Width
.Height = ActiveCell.Height
Me.TextBox1.Activate
End SubSub
▲当指定日期（每月10日）打开文件执行宏
Sub auto_open()
If Day(Date) = 10 Then
▲提示并清空单元区域
Sub 清空单元区域()
If MsgBox(&是否真的要清空数据?清除后将无法恢复&, 1 + vbokNo) = vbOK Then
Range(&A1:B10,A15:B25&).ClearContents
▲返回光标所在行号
Sub 返回光标所在行号()
Range(&A1&) = Selection.Row
▲VBA返回公式结果
Sub VBA返回公式结果()
x = Application.WorksheetFunction.Sum(Range(&a2:a100&))
Range(&B1&) = x
▲按照当前行A列的图片名称插入图片到H列
Sub 按照当前行A列的图片名称插入图片到H列()
AAA = Selection.Row
Range(&H& & AAA).Select
Selection.RowHeight = 37
'指定行高
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & &\& & Range(&A& & Selection.Row) & &.JPG&).
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 84.75
Selection.ShapeRange.Width = 150.75
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.ScaleWidth 0.73, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.73, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.24, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 2.5, msoFalse, msoScaleFromTopLeft
Range(&H& & AAA).Select
▲当前行下插入1行
Sub 当前行下插入1行()
Selection.Offset(1, 0).Insert
▲取消指定行或列的隐藏
Sub 取消隐藏行()
Rows(&3:5&).Select
Selection.EntireRow.Hidden = False
Sub 取消隐藏列()
Columns(&C:F&).Select
Selection.EntireColumn.Hidden = False
▲复制单元格所在行
Sub 复制单元格所在行()
Selection.EntireRow.Copy
▲复制单元格所在列
Sub 复制单元格所在列()
Selection.EntireColumn.Copy
▲新建一个工作表
Sub 新建一个工作表()
Sheets.Add
▲新建一个工作簿
Sub 新建一个工作簿()
Workbooks.Add
▲选择多表为工作组
Sub 选择多表为工作组()
Dim Wks As Worksheet, shtCnt As Integer
Dim arr() As Variant, i As Integer, m As Integer, m1 As Integer, m2 As Integer
shtCnt = ThisWorkbook.Sheets.Count '取得工作表总数
ReDim arr(1 To shtCnt) '预定义数组
'循环的次数
m1 = 0 '找到起点循环的次数
m2 = 0 '找到终点循环的次数
For Each Wks In ThisWorkbook.Sheets '在所有工作表中循环
If Wks.Name = &A2& Then
'工作组中第一个工作表名称
arr(i) = Wks.Name '将工作表名称存进数组
If Wks.Name Like &A7& Then
'工作组中最后一个个工作表名称
arr(i) = Wks.Name '将工作表名称存进数组
If i & 0 And m & m1 Then
arr(i) = Wks.Name '将工作表名称存进数组
If m2 & m1 Then '如果存在符合条件的工作表名称
ReDim Preserve arr(1 To i) '重定义数组
ThisWorkbook.Sheets(arr).Select '选中符合条件的所有工作表
▲在当前工作组各表中分别执行指定宏
Sub 在当前工作组各表中分别执行指定宏()
Dim SH As Worksheet
For Each SH In ActiveWindow.SelectedSheets
SH.Activate
'冰山上的来客解答
http://club.excelhome.net/dispbbs.asp?boardid=2&id=251426
'其中指定宏代码一定要避免执行工作表的Select方法
Dim SelShts As Sheets
Dim Sht As Worksheet
Sub 在当前工作组各表中分别执行指定宏()
Set SelShts = ActiveWindow.SelectedSheets
For Each Sht In SelShts
▲复制当前工作簿的报表到临时工作簿
Sub 复制当前工作簿的报表到临时工作簿()
'作者：yuanzhuping版主
Dim x As Integer
Dim sht As Worksheet
On Error Resume Next
For x = 1 To Workbooks.Count
If Workbooks(x).Name = &临时.xls& Then
For Each sht In Workbooks(x).Sheets
If sht.Name = &001& Then
MsgBox &已经有了001表&, 64, &提示&
三亿文库包含各类专业文献、专业论文、应用写作文书、高等教育、幼儿教育、小学教育、各类资格考试、外语学习资料、57300个常用excel宏_成为excel高手等内容。　
　办公高手EXCEL常用宏命令_电脑基础知识_IT/计算机_专业资料 暂无评价|0人阅读|0次下载|举报文档 办公高手EXCEL常用宏命令_电脑基础知识_IT/计算机_专业资料。... 　办公高手EXCEL常用宏命令_IT/计算机_专业资料。办公高手.EXCEL 办公高手.EXCEL 常用宏命令设置打开时弹出对话框的命令举例: 1 设置打开时弹出对话框的命令举例: Sub... 　Excel50个逆天功能,看完变Excel绝顶高手_电脑基础...在 Excel 中数据合并 10、在 Excel 中添加常用文件...“宏” 49、Excel 表格列宽行高设置 50、Excel“... 　成为Excel高手必学技巧_电脑基础知识_IT/计算机_专业...管理加载宏 40 在工作表之间使用超级连接 快速链接...4. 给单元格重新命名 Excel 给每个单元格都有一个... 　让你成为 Excel 高手 也许你已经在 Excel 中完成过...3.选中“常用文档”菜单中某个菜单项(如“工资表...符号输入到某个单元格中,再单击“录制宏”工具栏上... 　《精粹》中的精粹:成为 Excel 高手的捷径 精粹》中...学习者需要大致了解到 Excel 的基本操作方法和常用功...当然,还有些中级用户会使用简单的宏─ 数、TEXT ... 　50个逆天功能,看完变Excel绝顶高手_表格/模板_实用文档。50 个逆天功能,看完...Excel 分区域锁定 48、Excel 加载“宏” 49、Excel 表格列宽行高设置 50、... 　30min让你成为excel高手 隐藏&& 如果我们在用 Excel...现在我们可以借助 Excel XP 的“宏”功能,来记录...以下是几 种常见的错误及其解决方法。 1.###! 原因... 　30分钟变Excel高手 30页 免费 Excel使用技巧大全(超...现在我们可以借助 Excel XP 的“宏”功能,来记录...以下是几 种常见的错误及其解决方 法。 1.###!...下次自动登录
现在的位置:
& 综合 & 正文
通过java调用VBS，再用VBS执行Excel中的宏的例子
(一) 首先需要降低客户端及服务器端对于Excel的宏的安全级别的要求，按照下述的图示进行操作：
(1)进入宏的安全级别设置功能
(2) 降低宏的安全级别
按照下面编写VBS代码
OptionExplicit
Dim objXLApp
Dim objXLBook
Set objXLApp =WScript.CreateObject("Excel.Application")
‘注意以下的“e/data_test.xls”的位置需要修改为包含宏的那个excel的实际位置
‘位置需要设置为绝对路径
Set objXLBook =objXLApp.Workbooks.Open("e:/data_test.xls" )
‘doChangeExcel即为excel中的宏方法的名称
objXLApp.Run"doChangeExcel"
'objXLBook.Saved =True
objXLBook.Save
objXLBook.Close
Set objXLBook =Nothing
objXLApp.Quit
Set objXLApp =Nothing
WScript.Quit
(三) 以下是excel中的宏，仅需要复制到excel的宏中即可：
'authorguoqiang
Sub doChangeExcel()
count = Sheets.count
Debug.Print count
For i = 1 To count
'get the assigned sheet
Sheets.Item(i).Select
'get the name of the sheet
SheetName = ActiveSheet.Name
protected = ActiveSheet.ProtectContents
'ptotected = True
ActiveSheet.Select
'---------------------------------------
'if it is Trans_Xcpt sheet, then row 5 is autofilter
If SheetName = "Trans_Xcpt" Then
If protected = True Then
ActiveSheet.Select
ActiveSheet.Unprotect
Rows("5:5").Select
Selection.AutoFilter
Rows("5:5").Select
Selection.AutoFilter
ActiveSheet.Protect
'---------------------------------------
'if it is MTD_IN sheet, then row 4 is autofilter
ElseIf SheetName = "MTD_IN" Then
If protected = True Then
ActiveSheet.Select
ActiveSheet.Unprotect
Rows("4:4").Select
Selection.AutoFilter
Rows("4:4").Select
Selection.AutoFilter
ActiveSheet.Protect
'---------------------------------------
'if it is Net_Demand sheet, then row 4 is autofilter
ElseIf SheetName = "Net_Demand" Then
If protected = True Then
ActiveSheet.Select
ActiveSheet.Unprotect
Rows("4:4").Select
Selection.AutoFilter
Rows("4:4").Select
Selection.AutoFilter
ActiveSheet.Protect
'---------------------------------------
'if it is A_Supply sheet, then row 4 is autofilter
ElseIf SheetName = "A_Supply" Then
If protected = True Then
ActiveSheet.Select
ActiveSheet.Unprotect
Rows("4:4").Select
Selection.AutoFilter
Rows("4:4").Select
Selection.AutoFilter
ActiveSheet.Protect
'---------------------------------------
'if it is Special_Cell sheet, then row 4 is autofilter
ElseIf SheetName = "Special_Cell" Then
If protected = True Then
ActiveSheet.Select
ActiveSheet.Unprotect
Rows("4:4").Select
Selection.AutoFilter
Rows("4:4").Select
Selection.AutoFilter
ActiveSheet.Protect
'---------------------------------------
'else, only protect or unprotect
If protected = True Then
ActiveSheet.Select
ActiveSheet.Unprotect
ActiveSheet.Select
ActiveSheet.Protect
(四) 在java代码中进行执行（注意：仅仅支持windows2000以上的系统）：
//TODO:其他的代码
//以下是执行VBS代码
//注意“E:/Temp/vbs.vbs”应该是正确的存储的VBS代码的位置
Processprocess=Runtime.getRuntime().exec("cmd /c CScriptE:/Temp/vbs.vbs");
//等待VBS执行完毕
process.waitFor();
//TODO:其他的代码
注意：该宏会自动判断是否需要进行protect(宏中假定protect和autofilter是一致的，即同时为true或者false)。
&&&&推荐文章:
【上篇】【下篇】