分享

一小时搞定简单VBA编程 Excel宏编程快速上手

 昵称62862138 2019-05-28

Excel宏编程可以快速完成批量表格操作:复制粘贴、数据过滤等,宏代码基于VB语言实现,有基础的编程经验就能快速阅读。下面是我的学习笔记。

1. Excel VBA编辑界面
(进入路径: sheet名称 --> 鼠标右键菜单 --> 查看代码)

2. 输入代码方法:
在VBE编辑器的代码模块中输入VBA代码,通常有以下几种方法: 
■ 手工键盘输入; 
■ 使用宏录制器,即选择菜单“工具——宏——录制新宏”命令,将所进行的操作自动录制成宏代码; 
■ 复制/粘贴代码,即将现有的代码复制后,粘贴到相应的代码模块中; 
■ 导入代码模块:文件-->导入文件 **不用的模块可以:文件-->移出模块

3. VB代码阅读扫盲
(1) 模块声明:
  1. Sub sName() ... End Sub
  2. Sub xxxxx()
  3. XXXXXXXXX
  4. End Sub
(2) 变量声明:
  1. Dim sPara As sType
  2. Dim para1, para2, para3
  3. Dim para4 As workbook, para5 As String
  4. Dim G As Long
(3) 选择结构:
  1. With ... End With
  2. If condition Then ... End If
  3. With Workbooks(1).ActiveSheet
  4. For G = 1 To Sheets.Count
  5. Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
  6. Next
  7. WbN = WbN & Chr(13) & Wb.Name
  8. Wb.Close False
  9. End With
(4) 循环结构
  1. Do While condition ... Loop
  2. For i = 0 to 100 ... Next
(5) 输出Log:
MsgBox sString
解析拷贝路径下所有Excel到一个工作表下的示例:
************************************************************************************************************************************
  1. Sub 合并当前目录下所有工作簿的全部工作表() #模块名称
  2. Dim MyPath, MyName, AWbName #变量声明
  3. Dim Wb As workbook, WbN As String
  4. Dim G As Long
  5. Dim Num As Long
  6. Dim BOX As String
  7. Application.ScreenUpdating = False #停止屏幕刷新
  8. MyPath = ActiveWorkbook.Path #获取当前工作文件路径
  9. MyName = Dir(MyPath & "\" & "*.xls") #获取当前文件名(截取字符串)
  10. AWbName = ActiveWorkbook.Name #获取当前BookName
  11. Num = 0 #准备进入循环处理
  12. Do While MyName <> "" #第一个循环体:遍历所有文件 终止条件是 文件名为空
  13. If MyName <> AWbName Then #条件:文件名当前激活文件不同
  14. Set Wb = Workbooks.Open(MyPath & "\" & MyName) # 设置工作表的名称(当前Sheet Name)
  15. Num = Num + 1 #计数用于输出
  16. With Workbooks(1).ActiveSheet
  17. .Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
  18. #赋值语句:激活Sheet的A列最后一个单元格赋值为MyName去掉‘.xls’的部分
  19. #Left 截取字符串 去掉了'.xls'
  20. #workbooks(n) 为取工作簿 的写法
  21. #A65535(一个极大数)单元格向上,最后一个非空的单元格的行号
  22. For G = 1 To Sheets.Count #嵌套循环体:遍历文件的所有Sheets
  23. Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
  24. #赋值所有内容到以结束内容空一行开始的表格中
  25. Next #且套循环体结束
  26. WbN = WbN & Chr(13) & Wb.Name # & 为合并字符串的符号
  27. Wb.Close False #对于文件操作结束,关闭Excel文件
  28. End With #退出第二个判断
  29. End If #退出第一个判断
  30. MyName = Dir #怎么拿到第二个bookName
  31. Loop #循环体结束
  32. Range("B1").Select #选中B1
  33. Application.ScreenUpdating = True #允许Excel屏幕刷新
  34. MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示"
  35. End Sub

************************************************************************************************************************************
常用模块:
1. 把一个workBook的一块表格拷贝到另一个WorkBook中的一般化方法:
上面的代码中是一种简单的实现:拷贝所有内容到空行区域
需要将拷贝的内容和粘贴的位置控制更加精准控制:

拷贝指定位置到指定位置:
Workbooks("工作簿1.xls").Sheet1.Range("A1:C50").Copy ThisWorkbook.Sheet2.Range("A1")
2. 找到粘贴位置:
b=sheet2.[BI].end(xlToLeft).row+1 获取最后一次编辑的各自的列号!
.Range("B65536").End(xlUp).Row + 2 最后一次编辑的格子的行号
A1 直接编辑
.Cells(nRowNo, nColNo)
...


一个将多个相同格式表格合并生成横表的例子:
  1. Sub 合并当前目录下所有工作簿的全部工作表()
  2. Dim MyPath, MyName, AWbName
  3. Dim Wb As Workbook, WbN As String
  4. Dim G As Long
  5. Dim Num As Long
  6. Dim BOX As String
  7. Dim HasTitil As Boolean
  8. Dim LastRange As String
  9. Dim CurRowNo As Long
  10. Application.ScreenUpdating = False
  11. MyPath = ActiveWorkbook.Path
  12. MyName = Dir(MyPath & "\" & "*.xls")
  13. AWbName = ActiveWorkbook.Name
  14. Num = 0
  15. HasTitil = False
  16. With Workbooks(1).ActiveSheet
  17. .Cells(1, 2) = "Cor.Name"
  18. Do While MyName <> ""
  19. If MyName <> AWbName Then
  20. Set Wb = Workbooks.Open(MyPath & "\" & MyName)
  21. Num = Num + 1
  22. .Cells(1, Num + 2) = Left(MyName, Len(MyName) - 4)
  23. If HasTitil <> True Then
  24. Wb.Sheets(1).Range("A4:B43").Copy .Cells(2, 1)
  25. Wb.Sheets(1).Range("E4:F43").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
  26. Wb.Sheets(2).Range("A5:B73").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
  27. Wb.Sheets(2).Range("E5:F73").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
  28. Wb.Sheets(3).Range("A4:B32").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
  29. Wb.Sheets(3).Range("E4:F32").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
  30. Wb.Sheets(4).Range("A5:B100").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
  31. HasTitil = True
  32. End If
  33. CurRowNo = 2
  34. Wb.Sheets(1).Range("D4:D43").Copy .Cells(CurRowNo, Num + 2)
  35. CurRowNo = CurRowNo + 40
  36. Wb.Sheets(1).Range("H4:H43").Copy .Cells(CurRowNo, Num + 2)
  37. CurRowNo = CurRowNo + 40
  38. Wb.Sheets(2).Range("D5:D73").Copy .Cells(CurRowNo, Num + 2)
  39. CurRowNo = CurRowNo + 69
  40. Wb.Sheets(2).Range("H5:H73").Copy .Cells(CurRowNo, Num + 2)
  41. CurRowNo = CurRowNo + 69
  42. Wb.Sheets(3).Range("D4:D32").Copy .Cells(CurRowNo, Num + 2)
  43. CurRowNo = CurRowNo + 29
  44. Wb.Sheets(3).Range("H4:H32").Copy .Cells(CurRowNo, Num + 2)
  45. CurRowNo = CurRowNo + 29
  46. Wb.Sheets(4).Range("D5:D100").Copy .Cells(CurRowNo, Num + 2)
  47. Wb.Close False
  48. End If
  49. MyName = Dir
  50. Loop
  51. End With
  52. Range("B1").Select
  53. Application.ScreenUpdating = True
  54. End Sub

    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约