本文介绍了Excel VBA的基础知识，包括录制宏、For循环的使用，以及Dim变量声明。讲解了如何通过VBA进行单元格定位、数据处理，如根据条件填充内容和删除行。此外，还探讨了工作表的选择、添加、删除、复制等操作，以及如何实现多表数据的汇总和拆分。最后，展示了如何利用VBA进行错误处理和自定义函数的创建。
Excel vba
- 录制宏、绝对引用、相对引用
For循环
Dim i as interager
For i=1 to 100 step 7
Next
step 7 代表每7步执行一个动作
Range:定位单元格
Range(“a1”)
For函数
写代码跟删除有关的，要记得删除一行下一行会往上跑一行，循环可以从下往上走，
Step=-1
Sub pd()
Dim i As Integer
For i = 26 To 2 Step -1
'处理性别的代码
If Range("e" & i) = "男" Then
Range("f" & i) = "先生"
Else
Range("f" & i) = "女士"
End If
'处理专业代号
If Range("b" & i) = "理工" Then
Range("c" & i) = "LG"
ElseIf Range("b" & i) = "文科" Then
Range("c" & i) = "WK"
Else
Range("c" & i) = "CJ"
End If
If Range("d" & i) = "" Then
Range("D" & i).Select
Selection.EntireRow.Delete
End If
Next
End Sub
Sub gzt()
Dim i As Integer
For i = 3 To 2000 Step 2
If Range("A" & i) = "" Then
Exit For
End If
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Copy
Range("A" & i).Select
Selection.Insert Shift:=xlDown
Next
End Sub
第三节：
方法:select、add、delete、copy
属性：count、name
Select：
选中表的三种方式
Sheet1.select
Sheets(“1月”).select
Sheet(1).select
在最后一个表的后面添加一张表
count、name 为属性，方法带点、属性带等于
Sheets.add after:=sheets(sheets.count)
Delete ： 删表注意位置、警告的问题
添加11张表并改名月份
Sub shishi()
Dim i as intergar
For i=1 to 12
Sheets.add after:=sheet(sheets.count),count=100
Sheet(sheets.count)=i&”月”
next
End sub
将多个表名放到同一张表的单元格中
Sub qbm()
Dim i As Integer
For i = 2 To Sheets.Count
Range("a" & (i - 1)) = Sheets(i).Name
Next
End Sub
多个表的信息汇总到一个表中
Sub huizong()
Dim i As Integer
For i = 2 To Sheets.Count
Sheet1.Range("b" & (i + 8)) = Sheets(i).Range("e5")
Sheet1.Range("c" & (i + 8)) = Sheets(i).Range("e6")
Next
End Sub
删除表只留一张表：
Sub sc()
Dim biao As Worksheet
For Each biao In Sheets
Application.DisplayAlerts = False
If biao.Name <> "绝不能删" Then
biao.Delete
End If
Next
Application.DisplayAlerts = False
End Sub
表的话是 for each in
单元格是 for i=
定位单元格：[a1]、cells(10,1)、range(“a1”)、range(“a10”)value
重新做定位：range(“a1”).offet(0,1)、range(“a10”).end(xlup))
重新选择区域：range(“a10”).EntireRow、range(“a10”).resize(1,10)
改变数据的位置range(“a10”)copy
对于一个表，可按照不同列进行拆分、并设置按钮（第7课）
Sub chaifenshuju()
Dim sht As Worksheet
Dim k, i, j As Integer
Dim irow As Integer '这个说的是一共多少行
Dim l As Integer
l = InputBox("请输入你要按哪列分")
If isnumeric(l)=false or l<1 then
End sub
End if
L=l*1
'删除无意义的表
Application.DisplayAlerts = False
If Sheets.Count > 1 Then
For Each sht1 In Sheets
If sht1.Name <> "数据" Then
sht1.Delete
End If
Next
End If
Application.DisplayAlerts = True '这个地方上课的时候我没改成true，请大家注意一下
irow = Sheet1.Range("a65536").End(xlUp).Row
'拆分表
For i = 2 To irow
k = 0
For Each sht In Sheets
If sht.Name = Sheet1.Cells(i, l) Then
k = 1
End If
Next
If k = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet1.Cells(i, l)
End If
Next
'拷贝数据
For j = 2 To Sheets.Count
Sheet1.Range("a1:f" & irow).AutoFilter Field:=l, Criteria1:=Sheets(j).Name
Sheet1.Range("a1:f" & irow).Copy Sheets(j).Range("a1")
Next
Sheet1.Range("a1:f" & irow).AutoFilter
Sheet1.Select
MsgBox "已处理完毕"
End Sub
Inputbox输出的是文本类型，若要用cell(“a,l”)定义dim l as Interager，否则会发生错误
或者 加上 l=l*1
第7.8节
Selection选取
Selection change 选区发生改变时
当点击某一单元格时 整行变黄，当点击其他单元格时同理
Cells.Interior.Pattern = xlNone
Selection.EntireRow.Interior.Color = 65535
关闭change事件循环查询
Application.EnableEvents = False
设置筛选：
事件选择change
Application.EnableEvents = False
Range("l1:q10000").ClearContents
Range("A1:F232").AutoFilter Field:=4, Criteria1:=Range("i2")
Range("A1:F232").Copy Range("l1")
Range("A1:F232").AutoFilter
Application.EnableEvents = true
Format 相当于 text，转换时间为文本format（now(),yyyymmddhhmmss）
savecopyas 偷偷保存
文件自动备份
选择thisworkbook——workbook——beforesave 事件
Thiswork savecopyas “d:\data\”&format(now(),”yyyymmddhhmmss”)&”.xls”
第9节
Worksheetfuntion 工作表函数的集合
多表查询某一个字段的数据个数
Sub tongji()
Dim i, j, k, l As Integer
For i = 2 To Sheets.Count
k = k + Application.WorksheetFunction.CountA(Sheets(i).Range("a:a")) - 1
j = j + Application.WorksheetFunction.CountIf(Sheets(i).Range("f:f"), "男")
l = l + Application.WorksheetFunction.CountIf(Sheets(i).Range("f:f"), "女")
Next
Range("d26") = k
Range("d27") = j
Range("d28") = l
End Sub
On error resume next 当发生错误时帮我执行下一行
多表查询注意发生错误
使用vlookup函数进行多表查询字段
Sub chaxun()
On Error Resume Next
Sheet1.Range("d14").ClearContents
For i = 2 To Sheets.Count
Sheet1.Range("d14")=Application.WorksheetFunction.VLookup(Range("d9"), Sheets(i).Range("a:h"), 5, 0)
Sheet1.Range("d16")=Application.WorksheetFunction.VLookup(Range("d9"), Sheets(i).Range("a:h"), 6, 0)
Sheet1.Range("d18")=Application.WorksheetFunction.VLookup(Range("d9"), Sheets(i).Range("a:h"), 3, 0)
Sheet1.Range("d20")=Application.WorksheetFunction.VLookup(Range("d9"), Sheets(i).Range("a:h"), 8, 0)
Sheet1.Range("22") = Sheets(i).Name
If Sheet1.Range("d14") <> "" Then
Exit For
End If
Next
End Sub
Isnumeric判断是否为数字
Val将此文本变成数字形式
Instr函数， 查看某一字符是数值第几位
Split函数，按照某一东西进行分割
FW-15-2015-37-001
range(“b2”)= Split(range(“a2”,”-”)(2)&”年第”& Split(range(“a2”,”-”)(3)&”周”
函数存在于application.workfuntion 和 vba. 中
第10课
Dateserial函数
Mid函数取中间字符
自己制造函数
转美金：
Function zmj(str As String)
zmj = str / 6.03 - x * 0.03
End Function
提取身份证上的年月日
单元格中=rqzh(mid(zh,7,8))
Function rqzh(zh As String)
rqzh = DateSerial(Left(zh, 4), Mid(zh, 5, 2), Right(zh, 2))‘’
End Function
提取产品信息的年，周
Function tqnf(str, str1)
tqnf = Split(str, str1)(2) & "年第" & Split(str, str1)(3) & "周"
End Function
根据sheet1的a1单元格创建新的表
先创建通用函数
Sub cjb(str As String)
Dim sht As Worksheet
For Each sht In Sheets
If sht.Name = str Then
k = 1
End If
Next
If k = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = str
End If
End Sub
调用函数
Sub abc1()
Call cjb(Sheet1.Range("a1"))
Sheet1.Select
End Sub
将表格内所有表拆分另存到一个文件夹内
Sub test()
Dim sht As Worksheet
For Each sht In Sheets
sht.Copy
ActiveWorkbook.SaveAs Filename:="d:\data\" & sht.Name & ".xlsx"
ActiveWorkbook.Close
Next
End Sub
代码粘贴到新的工作表，保存到加载宏，开发工具选中加载项， 在快速访问工具栏中添加常用
扫一扫
2134
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
