一小时搞定 简单VBA编程 Excel宏编程快速扫盲

一小时搞定 简单VBA编程 Excel宏编程快速扫盲Excel宏编程可以快速完成批量表格操作:复制粘贴、数据过滤等,宏代码基于VB语言实现,有基础的编程经验就能快速阅读。下面是我的学习笔记。1.ExcelVBA编辑界面(进入路径:sheet名称–>鼠标右键菜单–>查看代码)2.输入代码方法:在VBE编辑器的代码模块中输入VBA代码,通常有以下几种方法:■手工键盘输入;■使用…

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

 

1. Excel VBA编辑界面

(进入路径: sheet名称 –> 鼠标右键菜单 –> 查看代码)

 

2. 输入代码方法:

在VBE编辑器的代码模块中输入VBA代码,通常有以下几种方法: 

■ 手工键盘输入; 

■ 使用宏录制器,即选择菜单“工具——宏——录制新宏”命令,将所进行的操作自动录制成宏代码; 

■ 复制/粘贴代码,即将现有的代码复制后,粘贴到相应的代码模块中; 

■ 导入代码模块:文件–>导入文件 **不用的模块可以:文件–>移出模块

 

3. VB代码阅读扫盲

(1) 模块声明:

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

# 举个例子:遍历每个Sheet把表粘贴成一个大表的语句,使用For Next With End With语句

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

(5) 输出Log:

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

 

************************************************************************************************************************************

常用模块:

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)

 

 

实战案例分析:一个将多个相同格式表格合并生成横表的例子:

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

 

版权声明:本文内容由互联网用户自发贡献,该文观点仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 举报,一经查实,本站将立刻删除。
如需转载请保留出处:http://bianchenghao.cn/4249.html

(0)
编程小号编程小号
上一篇 2022-12-26
下一篇 2022-12-26

相关推荐

发表回复

您的电子邮箱地址不会被公开。 必填项已用*标注