519678@TOC

VBA笔记

王佩丰VBA学习笔记
（按照课程分类）

for循环
for i = a to b
next
(先 dim)

Sub gzt()
Rows(“1:1”).Select
Dim i As Integer
For i = 1 To 10
Selection.Copy
ActiveCell.Offset(2, 0).Rows(“1:1”).EntireRow.Select
Selection.Insert Shift:=xlDown
Next
End Sub

Sub gzb()
Rows(“21:21”).Select
Dim i As Integer
For i = 1 To 10
Selection.Delete Shift:=xlUp
ActiveCell.Offset(-2, 0).Rows(“1:1”).EntireRow.Select
Next
End Sub

for循环加步长
for i =a to b step c

if条件
if a then b
else if c then d
else e
end if

退出循环
exit for

if条件并列
a and/or b

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
Selection.Copy
Range(“A” & i).Select
Selection.Insert Shift:=xlDown
Next
End Sub

Sub gzb()
Dim i As Integer
For i = 3 To 2000
If Range(“a” & i) = “” Then
Exit For
End If
Range(“A” & i).Select
Selection.EntireRow.Delete
Next
End Sub

Sub gsjs()
For i = 2 To 12
If Range(“c” & i) < 3500 Then
Range(“d” & i) = 0
ElseIf Range(“c” & i) >= 3500 And Range(“c” & i) < 5000 Then
Range(“d” & i) = (Range(“c” & i) - 3500) * 0.03
ElseIf Range(“c” & i) >= 5000 And Range(“c” & i) < 8000 Then
Range(“d” & i) = (Range(“c” & i) - 3500) * 0.1 - 105
ElseIf Range(“c” & i) >= 8000 And Range(“c” & i) < 12500 Then
Range(“d” & i) = (Range(“c” & i) - 3500) * 0.2 - 555
ElseIf Range(“c” & i) >= 12500 And Range(“c” & i) < 38500 Then
Range(“d” & i) = (Range(“c” & i) - 3500) * 0.25 - 1005
ElseIf Range(“c” & i) >= 38500 And Range(“c” & i) < 58500 Then
Range(“d” & i) = (Range(“c” & i) - 3500) * 0.3 - 2755
ElseIf Range(“c” & i) >= 58500 And Range(“c” & i) < 83500 Then
Range(“d” & i) = (Range(“c” & i) - 3500) * 0.35 - 5505
ElseIf Range(“c” & i) >= 83500 Then
Range(“d” & i) = (Range(“c” & i) - 3500) * 0.45 - 13505
End If
Next
End Sub

操作工作表
Sheet1/Sheets(“名字”)/Sheets(1)
Sheet1.range(“a1”)

方法：Select/Add/Delete/Copy
属性：Count/Name

Sheets.Add after:= Sheets(Sheets.Count), count:=3

解除警告
Excel.Application.DisplayAlerts = False

Sheets(i).range(“a1”).Select 不能跨表操作

Sub cjb()
Dim i, j As Integer
For j = 1 To Sheets.Count
For i = 100 To 2 Step -1
'性别
If Sheets(j).Range(“e” & i) = “男” Then
Sheets(j).Range(“f” & i) = “先生”
Else
Sheets(j).Range(“f” & i) = “女士”
End If
'代号
If Sheets(j).Range(“b” & i) = “理工” Then
Sheets(j).Range(“c” & i) = “LG”
ElseIf Range(“b” & i) = “文科” Then
Sheets(j).Range(“c” & i) = “WK”
Else
Sheets(j).Range(“c” & i) = “CJ”
End If
'删除
If Sheets(j).Range(“d” & i) = “” Then
Sheets(j).Range(“d” & i).EntireRow.Delete
End If
Next
Next
End Sub

操作工作簿
方法：Open/Add/Save/Close

Workbooks.Open Filename:= “”

ActiveWorkbook

for each循环
1.Dim rng As Range
For Each rng In Range(“a1:a10”)
Next
2.Dim sht As Worksheet
For Each sht In Sheets
Next

Sub cjb()
Dim sht As Worksheet
Dim i As Integer
For Each sht In Sheets
For i = 100 To 2 Step -1
'性别
If sht.Range(“e” & i) = “男” Then
sht.Range(“f” & i) = “先生”
Else
sht.Range(“f” & i) = “女士”
End If
'代号
If sht.Range(“b” & i) = “理工” Then
sht.Range(“c” & i) = “LG”
ElseIf Range(“b” & i) = “文科” Then
sht.Range(“c” & i) = “WK”
Else
sht.Range(“c” & i) = “CJ”
End If
'删除
If sht.Range(“d” & i) = “” Then
sht.Range(“d” & i).EntireRow.Delete
End If
Next
sht.Copy
ActiveWorkbook.SaveAs Filename:=“C:\Users\tang\Desktop\1” & sht.Name & “.xlsx”
ActiveWorkbook.Close
Next
End Sub

操作单元格
[a1]/Cells(行,列)/Range(“a1”)
单元格的值：Range(“a1”).Value
单元格偏移：Range(“a1”).Offset(行,列)
单元格底部：Range(“a65536”).End(xlUp)
单元格整行：Range(“a1”).EntireRow
单元格区域：Range(“a1”).resize(行,列)
单元格复制：Range(“a1”).Copy Range(“a2”)
合并单元格：Range(“a1:a2”).Merge
清除单元格：Range(“a1”).ClearContents

运行宏
Call 宏名

筛选
Sheet1.Range(“a1:f1048”).AutoFilter Field:=列数, Criteria1:=””
Selection.AutoFilter （取消筛选状态）

Sub sx()
Dim i As Integer
For i = 2 To Sheets.Count
Sheet1.Selection.AutoFilter
ActiveSheet.Range("$A1:1:1:F$1048").AutoFilter Field:=4, Criteria1:=Sheets(i).Name
Sheet1.Range(“a2:f” & Range(“a65536”).End(xlUp).Row).Copy Sheets(i).Range(“a2”)
Sheet1.Selection.AutoFilter
Next
End Sub

MsgBox “”
InputBox “”

Sub hb()
Dim i As Integer
For i = 2 To Sheets.Count
If i = 2 Then
Sheets(i).Range(“a1:f” & Sheets(i).Range(“a65536”).End(xlUp).Row).Copy Sheet1.Range(“a1”)
Else
Sheets(i).Range(“a2:f” & Sheets(i).Range(“a65536”).End(xlUp).Row).Copy Sheet1.Range(“a” & Sheet1.Range(“a65536”).End(xlUp).Row + 1)
End If
Next
Sheet1.Select
End Sub

Sub ss()
Dim i, k As Integer
Dim sht As Worksheet
For i = 1 To 3
k = 0
For Each sht In Sheets
If sht.Name = Sheet1.Range(“a” & i) Then
k = 1
End If
Next
If k = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet1.Range(“a” & i)
End If
Next
End Sub

Dim i, j, k As Integer
Dim l As Integer
Dim sht, sht1 As Worksheet
Dim irow As Integer '定义行数
l = InputBox(“请问你要按哪列分?”)
Application.DisplayAlerts = False
For Each sht1 In Sheets
If sht1.Name <> “数据” Then
sht1.Delete
End If
Next
Application.DisplayAlerts = 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
End Sub

With语句
With
End With

字体
Font

事件change
Application.EnableEvents=False
Application.EnableEvents=True

全部刷新
RefreshAll

日期函数
=now()

文本函数(excel)
=text(a1,”格式代码”)

文本函数(vba)
=format()

备份
SaveCopyAs

工作簿隐藏
Visible=false

Sub mm()
Dim i As Integer
i = InputBox(“请输入密码”)
If i = 123 Then
Sheets(“张三1”).Visible = True
Sheets(“张三2”).Visible = True
Sheets(“张三3”).Visible = True
ElseIf i = 456 Then
Sheets(“李四1”).Visible = True
Sheets(“李四2”).Visible = True
Sheets(“李四3”).Visible = True
End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets(“张三1”).Visible = False
Sheets(“张三2”).Visible = False
Sheets(“张三3”).Visible = False
Sheets(“李四1”).Visible = False
Sheets(“李四2”).Visible = False
Sheets(“李四3”).Visible = False
End Sub

Private Sub Workbook_Open()
Call ss
End Sub

工作表函数
Application.WorksheetFunction.函数

VBA函数
VBA.
判断是否为数字：Isnumeric()
转化为数字：val()
两大文本函数
查询：Instr(range(“a1”),””)
拆分：Split(range(“a1”),””)()
日期函数：DateTime.DateSerial(y,m,d)

错误回避
On error resume next

Sub jsrq1()
Dim i As Integer
For i = 2 To Range(“a65536”).End(xlUp).Row
Range(“b” & i) = VBA.DateTime.DateSerial(Strings.Left(Range(“a” & i), 4), Strings.Mid(Range(“a” & i), 5, 2), Strings.Right(Range(“a” & i), 2))
Next
End Sub

Sub jsrq2()
Dim i As Integer
For i = 2 To Range(“a65536”).End(xlUp).Row
Range(“b” & i) = VBA.DateTime.DateSerial(Strings.Mid(Range(“a” & i), 7, 4), Strings.Mid(Range(“a” & i), 11, 2), Strings.Mid(Range(“a” & i), 13, 2))
Next
End Sub

Sub chuangjianbiao()
Dim irow, i, j, k As Integer
Dim iCol As Integer
Dim sht As Worksheet
iCol = InputBox(“要分第几列呢?”)
Application.DisplayAlerts = False
For Each sht In Sheets
If sht.Name <> “数据” Then
sht.Delete
End If
Next
Application.DisplayAlerts = True
irow = Sheet1.Range(“a65536”).End(xlUp).Row
For j = 2 To irow
k = 0
For i = 1 To Sheets.Count
If Sheets(i).Name = Sheet1.Cells(j, iCol) Then
k = k + 1
End If
Next
If k = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet1.Cells(j, iCol)
End If
Next
For i = 2 To Sheets.Count
Sheet1.Range(“a1:f” & irow).AutoFilter Field:=iCol, Criteria1:="=" & Sheets(i).Name
Sheet1.Range(“a1:f” & irow).Copy Sheets(i).Range(“a1”)
Next
Sheet1.Range(“a1:a” & irow).AutoFilter
Sheet1.Select
End Sub

定义函数
Function 名字（变量）

代码库
另存为xla/xlam
加载项
快速访问工具栏

ActiveSheet

Function zmj(x)
zmj = x / 6.03 - x * 0.03
End Function

Function xb(str As String)
If str = “男” Then
xb = “先生”
Else
xb = “女士”
End If
End Function

Sub cfsj()
Dim sht As Worksheet
Dim k, i, j As Integer
Dim irow As Integer '这个说的是一共多少行
Dim l As Integer
l = InputBox(“请输入你要按哪列分”)
'删除无意义的表
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
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

对象赋值变量
Set sht = Sheet.Add

Dir函数（查询文件）
Dir(“路径名*.xls*”)

通配符
“*”
查找函数
Range(“a:a”).find (“”)

判断有无内容
If a is nothing then

Sub wjhb()
Dim str As String
Dim wb As Workbook
Dim i, j As Integer
str = Dir(“d:\data*.xls*”)
For i = 1 To 100
Set wb = Workbooks.Open(“d:\data” & str)
i = wb.Sheets(1).Range(“a65535”).End(xlUp).Row
j = ThisWorkbook.Sheets(“数据”).Range(“a65535”).End(xlUp).Row
wb.Sheets(1).Range(“a2:g” & i).Copy ThisWorkbook.Sheets(“数据”).Range(“a” & j +
ThisWorkbook.Sheets(“数据”).Range(“h” & j + 1).Resize(i - 1, 1) = Split(wb.Name, “.”)(0)
wb.Close
str = Dir
If str = “” Then
Exit For
End If
Next
End Sub

计算代码运行时间
t=timer
timer-t

数组
Dim arr()

Dim arr(1 to 4)：4个数据存于一行

Dim arr()
Redim arr(范围)

界限：Ubound(arr)/Lbound(arr)

Sub ss()
Dim arr()
Dim i, j As Integer
j = Range(“a65536”).End(xlUp).Row - 1
ReDim arr(1 To j)
For i = 1 To j
arr(i) = Range(“b” & i + 1) * Range(“c” & i + 1)
Next
Range(“h3”) = Application.WorksheetFunction.Max(arr)
Range(“h2”) = Range(“a” & Application.WorksheetFunction.Match(Range(“h3”), arr) + 1)
End Sub

Sub ss()
Dim arr()
Dim i, j, k, l As Integer
Dim t
t = Timer
arr = Range(“a1:a80”)
For i = 2 To 80
For j = 2 To 80
For k = 2 To 80
For l = 2 To 80
If arr(i, 1) + arr(j, 1) + arr(k, 1) + arr(l, 1) = 124704 Then
Range(“f3”) = arr(i, 1)
Range(“g3”) = arr(j, 1)
Range(“h3”) = arr(k, 1)
Range(“i3”) = arr(l, 1)
GoTo 100
End If
Next
Next
Next
Next
100
Range(“l3”) = Timer - t
End Sub

按钮控件
属性：Caption/Enable/Visible

单选按钮控件
属性：GroupName/Value(True/False)

微调按钮控件
属性：Value/Max/Min

Sub ss(i As Integer)
With Sheet2
.OptionButton1.Value = False
.OptionButton2.Value = False
.OptionButton3.Value = False
.OptionButton4.Value = False
.Label2 = Sheet2.SpinButton1.Value
.Label3 = Sheet3.Range(“a” & i + 1)
.Label4 = Sheet3.Range(“b” & i + 1)
.Label5 = Sheet3.Range(“c” & i + 1)
.Label6 = Sheet3.Range(“d” & i + 1)
.Label7 = Sheet3.Range(“e” & i + 1)
If .Label6 = “” Then
.OptionButton3.Visible = False
Else
.OptionButton3.Visible = True
End If
If .Label7 = “” Then
.OptionButton4.Visible = False
Else
.OptionButton4.Visible = True
End If
If Sheet3.Range(“g” & i + 1) = “A” Then
.OptionButton1.Value = True
ElseIf Sheet3.Range(“g” & i + 1) = “B” Then
.OptionButton2.Value = True
ElseIf Sheet3.Range(“g” & i + 1) = “C” Then
.OptionButton3.Value = True
ElseIf Sheet3.Range(“g” & i + 1) = “D” Then
.OptionButton4.Value = True
End If
End With
End Sub

Sub ssss()
Dim i, k As Integer
For i = 2 To 9
With Sheet3
If .Range(“f” & i) = .Range(“g” & i) Then
k = k + 1
End If
End With
Next
MsgBox “共答对” & k & “题”
End Sub

Private Sub CommandButton3_Click()
Call ssss
With Sheet2
.OptionButton1.Enabled = False
.OptionButton2.Enabled = False
.OptionButton3.Enabled = False
.OptionButton4.Enabled = False
.CommandButton3.Enabled = False
End With
End Sub

Private Sub OptionButton1_Click()
Sheet3.Range(“g” & Sheet2.Label2.Caption + 1) = “A”
End Sub

Private Sub OptionButton2_Click()
Sheet3.Range(“g” & Sheet2.Label2.Caption + 1) = “B”
End Sub

Private Sub OptionButton3_Click()
Sheet3.Range(“g” & Sheet2.Label2.Caption + 1) = “C”
End Sub

Private Sub OptionButton4_Click()
Sheet3.Range(“g” & Sheet2.Label2.Caption + 1) = “D”
End Sub

Private Sub SpinButton1_Change()
Call ss(Sheet2.SpinButton1.Value)
End Sub

窗体
属性：ShowModal/Show/Hide
操作：Activate/QueryClose
简写：Userform-me

Application.Visible
Application.Quit

文本框
属性：TabIndex/PasswordChar(*)

复合框
操作：AddItem/RemoveItem/Clear
属性：List/ListCount

Private Sub TextBox1_Change()
Dim arr()
If Len(TextBox1.Value) >= 4 Then
Me.ListBox1.Clear
arr = Sheet1.Range(“i2:i” & Sheet1.Range(“a65536”).End(xlUp).Row)
For i = LBound(arr) To UBound(arr)
If InStr(arr(i, 1), Me.TextBox1.Value) > 0 Then
Me.ListBox1.AddItem arr(i, 1)
End If
Next
If Me.ListBox1.ListCount > 0 Then
Me.ListBox1.Visible = True
End If
Else
Me.ListBox1.Clear
Me.ListBox1.Visible = False
End If
End Sub

InputBox方法
Application.InputBox()
可限制输入格式

Application.GetOpenFilename(“Excel文件,.xls”)
可选择是否多选

Sub test()
Dim str()
Dim i As Integer
Dim wb, wb1 As Workbook
Dim sht As Worksheet
On Error Resume Next '这一句上课时候没加，加上以后防止点了取消发生的错误
Set wb1 = ActiveWorkbook
Set sht1 = ActiveSheet
On Error Resume Next
str = Application.GetOpenFilename(“Excel数据文件,.xls”, , , , True)
For i = LBound(str) To UBound(str)
Set wb = Workbooks.Open(str(i))
For Each sht In wb.Sheets
sht.Copy after:=wb1.Sheets(wb1.Sheets.Count)
wb1.Sheets(wb1.Sheets.Count).Name = Split(wb.Name, “.”)(0) & sht.Name
Next
wb.Close
Next
End Sub

利用ADO操作外部数据
工具—引用—勾选Microsoft ActiveX Data Object x.x Library
Dim conn As New ADODB.Connection
conn.Open
“Provider=Microsoft.ACE.OLEDB.12.0;Data
Source=D:\data\data.xlsx;extended properties=”“excel 12.0;HDR=YES”""
conn.Close

查询数据
select * from [data$]

查询某几个字段
select 姓名,年龄 from [data$]

带条件的查询
select * from [data$] where 性别 = "男“

合并两个表的数据
select * from [data]unionallselect∗from[data2] union all select * from [data2]unionallselect∗from[data2]

插入新纪录
insert into [data$] (姓名,性别,年龄) values (‘AA’,‘男’,33)

抓取数据
Range(“a1”).CopyFromRecordset conn.Execute(“select * from [data$]”）

修改一条数据
update [data$] set 性别=‘男’,年龄=16 where 姓名=‘张三‘

删除一条数据
delete from [data$] where 姓名=‘张三’

使用LEFT JOIN …ON… (类似于VLOOKUP）
select [data3].姓名,性别,年龄,月薪from[data].姓名,性别,年龄,月薪 from [data].姓名,性别,年龄,月薪from[data] left join [data3]on[data] on [data]on[data].姓名=[data3$].姓名

先UNION ALL 再LEFT JOIN
select * from (select * from [data]unionallselect∗from[data2] union all select * from [data2]unionallselect∗from[data2])a left join [data3]ona.姓名=[data3] on a.姓名=[data3]ona.姓名=[data3].姓名

Sub ss()
Dim conn As New ADODB.Connection
Dim sql As String
conn.Open “Provider = Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\tang\Desktop\王佩丰 VBA 课件\第十六课\data\Edata.xlsx;extended properties=”“excel 12.0;HDR=YES”""
sql = “select a.姓名,性别,年龄,月薪 from (select * from[data]unionallselect∗from[data2] union all select * from [data2]unionallselect∗from[data2])a left join [data3]ona.姓名=[data3] on a.姓名=[data3]ona.姓名=[data3].姓名”
Range(“a2:z100”).ClearContents
Range(“a2”).CopyFromRecordset conn.Execute(sql)
conn.Close
End Sub

Sub sss()
Dim conn As New ADODB.Connection
Dim sql As String
conn.Open “Provider = Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\tang\Desktop\王佩丰 VBA 课件\第十六课\data\Adata.accdb”
sql = “delete from [客户信息表] where 公司名称= ‘森通’”
Range(“a2:z100”).ClearContents
conn.Execute (sql)
conn.Close
End Sub

Shapes
Dim shp as Shape
属性：Shp.TopLeftCell.Address
Shp.Type
Shp.Placement
操作：Shp.AddPicture/Shp.AddChart
改文件名
Name “” as “”

表单控件
分组框相当于GroupName

Like运算符
适用if条件
Like ””(通配符)/”?”(一个符号)/“[A-Z a-z]”/”[0-9]*”/”#”(一个数字)/”[!0-9]”/”[!A-Z a-z]”

Sub sss()
Dim shp As Shape
For Each shp In Sheet1.Shapes
i = i + 1
Range(“a” & i) = shp.Name
Range(“b” & i) = shp.TopLeftCell.Address
Next
End Sub

共有与私有
Public sub/Private sub
变量定义在最外面可被共用
跨模块使用变量 Public i as Integer

类模块
改类模块名字 SuperSheets/SuperRanges
Dim aaa as New SuperSheets

Do While循环
Do While
Loop
字典
用于取不同值
1.工具-引用-勾选Microsoft Scripting Runtime
Dim dic As New Dictionary
Dic(key)=Item
2.Dim dic
Set dic = CreateObject(“Scripting.Dictionary”)

**文本框**
属性：Column Count/ColumnWidths

Sub ss()
Dim arr
Dim dic As New Dictionary
arr = Range(“a2:b13”)
For i = LBound(arr) To UBound(arr)
dic(arr(i, 2)) = 1
Next
Sheet2.ListBox1.List = dic.Keys
End Sub

Dim arr()
Dim ID As String
Dim dj As Long
Private Sub CommandButton1_Click()
If Me.ListBox1.Value <> “” And Me.ListBox2.Value <> “” And Me.ListBox3.Value <> “” And Me.TextBox1 > 0 Then
Me.ListBox4.AddItem
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 0) = ID
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 1) = Me.ListBox1.Value
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 2) = Me.ListBox2.Value
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 3) = Me.ListBox3.Value
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 4) = Me.TextBox1.Value
Me.ListBox4.List(Me.ListBox4.ListCount - 1, 5) = Me.TextBox1.Value * Me.Label3.Caption
Else
MsgBox “请正确选择商品”
End If
Me.Label5.Caption = Me.Label5.Caption + Me.TextBox1.Value * Me.Label3.Caption
End Sub

Private Sub CommandButton2_Click()
Dim i As Integer
For i = 0 To Me.ListBox4.ListCount - 1
If Me.ListBox4.Selected(i) = True Then
Me.Label5.Caption = Me.Label5.Caption - Me.ListBox4.List(i, 5)
Me.ListBox4.RemoveItem i
End If
Next
End Sub

Private Sub CommandButton3_Click()
Dim DDID As String
Dim i
i = Sheet2.Range(“a65536”).End(xlUp).Row + 1
For j = 0 To Me.ListBox4.ListCount - 1
DDID = “D” & Format(Now, “yyyymmddhhmmss”)
Sheet2.Range(“a” & i) = DDID
Sheet2.Range(“b” & i) = Date
Sheet2.Range(“c” & i) = Me.ListBox4.List(j, 0)
Sheet2.Range(“d” & i) = Me.ListBox4.List(j, 4)
Sheet2.Range(“e” & i) = Me.ListBox4.List(j, 5)
i = i + 1
Next
MsgBox “结算成功”
Unload Me
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim dic
Dim i As Integer
Set dic = CreateObject(“Scripting.Dictionary”)
Me.ListBox2.Clear
For i = LBound(arr) To UBound(arr)
If arr(i, 2) = Me.ListBox1.Value Then
dic(arr(i, 3)) = 1
End If
Next
Me.ListBox2.List = dic.keys
Me.ListBox3.Clear
Me.Label3.Caption = 0
End Sub

Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim dic
Dim i As Integer
Set dic = CreateObject(“Scripting.Dictionary”)
Me.ListBox3.Clear
For i = LBound(arr) To UBound(arr)
If arr(i, 2) = Me.ListBox1.Value And arr(i, 3) = Me.ListBox2.Value Then
dic(arr(i, 4)) = 1
End If
Next
Me.ListBox3.List = dic.keys
Me.Label3.Caption = 0
End Sub

Private Sub ListBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
For i = LBound(arr) To UBound(arr)
If arr(i, 2) = Me.ListBox1.Value And arr(i, 3) = Me.ListBox2.Value And arr(i, 4) = Me.ListBox3.Value Then
ID = arr(i, 1)
dj = arr(i, 5)
Me.Label3.Caption = dj
End If
Next
End Sub

Private Sub UserForm_Activate()
Dim dic
Dim i As Integer
arr = Sheet1.Range(“a2:e” & Sheet1.Range(“a65536”).End(xlUp).Row)
Set dic = CreateObject(“Scripting.Dictionary”)
For i = LBound(arr) To UBound(arr)
dic(arr(i, 2)) = 1
Next
Me.ListBox1.List = dic.keys
End Sub

Listbox1.Selected (i)

Unload

工具-VBA Project 属性-保护-查看时锁定工程
工具-选项-要求变量声明

王佩丰VBA学习笔记相关推荐

王佩丰Excel学习笔记
王佩丰Excel学习笔记算术不需要写等号:选项-高级-转换Lotus 1-2-3 公式两个表格排列:视图-全部重排插入多张工作表:先选择多张表格再添加插入多行:先选择多行再添加改变列顺序:按 ...
王佩丰excel学习笔记（一）：第一——二讲
目录第一讲第二讲不努力就会落后,嘤嘤嘤.一周没发文章,就眼看着我的阅读量一步步往下掉,但我也不知道应该写啥,索性来写写我的excel学习笔记(主要原因是我看完就忘了,又懒得翻视频,干脆写下来). ...
王佩丰excel学习笔记（五）：第十五——十八讲
目录第十五讲第十六讲第十七讲第十八讲第十五讲根据某些条件突出显示单元格:开始-条件格式-突出显示单元格规则制作数据范围趋势:开始-条件格式-数据条用于分组统计:插入-切片器多重条件格 ...
王佩丰excel学习笔记（二）：第三——六讲
目录第三讲第四讲第五讲第六讲第三讲查找替换学会利用"查找替换"中的"选项": 匹配中的"?"代表一个字符,"*&qu ...
王佩丰excel学习笔记（四）：第十一——十四讲
目录第十一讲第十二讲第十三讲第十四讲第十一讲 vlookup(查找条件, 查找区域, 要返回列在查找区域第几列, 0/1):注意在查找区域里,查找条件所在列必须是最左侧第一列,0为精确匹配, ...
王佩丰excel学习笔记（三）：第七——十讲
目录第七讲第八讲第九讲第十讲第七讲 excel连接文本: & 各种基础运算相对引用与绝对引用:利用"$",按F4可以快速加美元号(但我电脑不行) 函数:sum( ...
王佩丰excel教程笔记（单元格设置）
设置单元格格式对话框合并后居中跨越合并可以一次合并多行改字体改字体颜色填充单元格背景色在设置单元格选项卡下可以给一个单元格绘制线条例如斜线 Alt+回车实现一个单元格换行. 框线设置 ...
王佩丰excel课程笔记
分类汇总按什么分类,汇总什么,用什么方式汇总使用分类汇总前先排序替换当前分类汇总,嵌套式分类汇总(替换当前分类汇总) alt+; 可见单元格快捷键使用分类汇总功能快速合并相同内容单元格:分类汇 ...
王佩丰excel教程笔记（查找替换定位）
查找和替换为一项工具,快捷键ctrl+h 替换时,会出现这样的问题把所有的 "张"替换为"张峰",如果有的单元格就是"张峰"则会被改为& ...
[OfficeExcel] 王佩丰老师OfficeExcel2010 5-6 讲数据有效性与数据透视表学习笔记
王佩丰老师OfficeExcel2010 学习笔记 Excel分类汇总和数据有效性 Excel 数据透视表视频链接: link. Excel分类汇总和数据有效性分地区统计金额的总计:使用分类汇总前 ...

王佩丰VBA学习笔记

VBA笔记

王佩丰VBA学习笔记相关推荐

最新文章

热门文章