Excel宏编程可以快速完成批量表格操作:复制粘贴、数据过滤等,宏代码基于VB语言实现,有基础的编程经验就能快速阅读。下面是我的学习笔记。
- Sub sName() ... End Sub
- Sub xxxxx()
- XXXXXXXXX
- End Sub
(2) 变量声明:- Dim sPara As sType
- Dim para1, para2, para3
- Dim para4 As workbook, para5 As String
- Dim G As Long
(3) 选择结构: - With ... End With
- If condition Then ... End If
- With Workbooks(1).ActiveSheet
- For G = 1 To Sheets.Count
- Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
- Next
- WbN = WbN & Chr(13) & Wb.Name
- Wb.Close False
- End With
(4) 循环结构- Do While condition ... Loop
- For i = 0 to 100 ... Next
MsgBox sString
解析拷贝路径下所有Excel到一个工作表下的示例:- Sub 合并当前目录下所有工作簿的全部工作表() #模块名称
- Dim MyPath, MyName, AWbName #变量声明
- Dim Wb As workbook, WbN As String
- Dim G As Long
- Dim Num As Long
- Dim BOX As String
- Application.ScreenUpdating = False #停止屏幕刷新
- MyPath = ActiveWorkbook.Path #获取当前工作文件路径
- MyName = Dir(MyPath & "\" & "*.xls") #获取当前文件名(截取字符串)
- AWbName = ActiveWorkbook.Name #获取当前BookName
- Num = 0 #准备进入循环处理
- Do While MyName <> "" #第一个循环体:遍历所有文件 终止条件是 文件名为空
- If MyName <> AWbName Then #条件:文件名当前激活文件不同
- Set Wb = Workbooks.Open(MyPath & "\" & MyName) # 设置工作表的名称(当前Sheet Name)
- Num = Num + 1 #计数用于输出
- With Workbooks(1).ActiveSheet
- .Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
- #赋值语句:激活Sheet的A列最后一个单元格赋值为MyName去掉‘.xls’的部分
- #Left 截取字符串 去掉了'.xls'
- #workbooks(n) 为取工作簿 的写法
- #A65535(一个极大数)单元格向上,最后一个非空的单元格的行号
- For G = 1 To Sheets.Count #嵌套循环体:遍历文件的所有Sheets
- Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
- #赋值所有内容到以结束内容空一行开始的表格中
- Next #且套循环体结束
- WbN = WbN & Chr(13) & Wb.Name # & 为合并字符串的符号
- Wb.Close False #对于文件操作结束,关闭Excel文件
- End With #退出第二个判断
- End If #退出第一个判断
- MyName = Dir #怎么拿到第二个bookName
- Loop #循环体结束
- Range("B1").Select #选中B1
- Application.ScreenUpdating = True #允许Excel屏幕刷新
- MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示"
- End Sub
- Sub 合并当前目录下所有工作簿的全部工作表()
- Dim MyPath, MyName, AWbName
- Dim Wb As Workbook, WbN As String
- Dim G As Long
- Dim Num As Long
- Dim BOX As String
- Dim HasTitil As Boolean
- Dim LastRange As String
- Dim CurRowNo As Long
- Application.ScreenUpdating = False
- MyPath = ActiveWorkbook.Path
- MyName = Dir(MyPath & "\" & "*.xls")
- AWbName = ActiveWorkbook.Name
- Num = 0
- HasTitil = False
- With Workbooks(1).ActiveSheet
- .Cells(1, 2) = "Cor.Name"
- Do While MyName <> ""
- If MyName <> AWbName Then
- Set Wb = Workbooks.Open(MyPath & "\" & MyName)
- Num = Num + 1
- .Cells(1, Num + 2) = Left(MyName, Len(MyName) - 4)
- If HasTitil <> True Then
- Wb.Sheets(1).Range("A4:B43").Copy .Cells(2, 1)
- Wb.Sheets(1).Range("E4:F43").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
- Wb.Sheets(2).Range("A5:B73").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
- Wb.Sheets(2).Range("E5:F73").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
- Wb.Sheets(3).Range("A4:B32").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
- Wb.Sheets(3).Range("E4:F32").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
- Wb.Sheets(4).Range("A5:B100").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
- HasTitil = True
- End If
- CurRowNo = 2
- Wb.Sheets(1).Range("D4:D43").Copy .Cells(CurRowNo, Num + 2)
- CurRowNo = CurRowNo + 40
- Wb.Sheets(1).Range("H4:H43").Copy .Cells(CurRowNo, Num + 2)
- CurRowNo = CurRowNo + 40
- Wb.Sheets(2).Range("D5:D73").Copy .Cells(CurRowNo, Num + 2)
- CurRowNo = CurRowNo + 69
- Wb.Sheets(2).Range("H5:H73").Copy .Cells(CurRowNo, Num + 2)
- CurRowNo = CurRowNo + 69
- Wb.Sheets(3).Range("D4:D32").Copy .Cells(CurRowNo, Num + 2)
- CurRowNo = CurRowNo + 29
- Wb.Sheets(3).Range("H4:H32").Copy .Cells(CurRowNo, Num + 2)
- CurRowNo = CurRowNo + 29
- Wb.Sheets(4).Range("D5:D100").Copy .Cells(CurRowNo, Num + 2)
- Wb.Close False
- End If
- MyName = Dir
- Loop
- End With
- Range("B1").Select
- Application.ScreenUpdating = True
- End Sub
联系客服