基础
学习资料
《[Excel.VBA常用代码实战大全].袁竹平.扫描版》
代码地址1:https://github.com/frankzheng43/-VBA-in-practice
代码地址2:https://github.com/teishorinchina/VBA_test_code
打开方法
打开:ALT+F11 ;工具-宏-vb编辑器
F5运行,F8下一步
右键单击工作表标签,执行【查看代码】菜单命令
单击【Visual Basic】工具栏中的【Visual Basic编辑器】按钮。
控件工具箱
过程
因为VBA程序一般保存在模块里,所以在编写程序前,应先添加一个模块来保存它 Public Sub mysub() MsgBox "sereny welcomde" End Sub
F5保存后运行
数据类型
commonly used built-in data types: Integer, Long, Single, Double, Boolean, String
Integer 2 byte
integer Long 4 byte
integer Single 4 byte
floating point (Real)
Double 8 byte
floating point (Real)
Currency 8 byte real
String up to 64K
characters Byte 1 byte
Boolean 2 byte true or false
Date 8 bytes
Object 4 bytes – an object reference
Variant 16 bytes + 1 byte / character
实现菜单栏管理与自定义菜单栏功能
https://blog.csdn.net/majinggogogo/article/details/10472595
在 VBA 中皆用 CommandBar 对象表示:在 VBA 和 Microsoft Visual Basic 中,按钮和菜单项用 CommandBarButton 对象表示。显示菜单和子菜单的弹出控件用 CommandBarPopup 对象表示。在以下示例中,名为“Menu”的控件和名为“Submenu”的控件都是用于显示菜单和子菜单的弹出控件,并且这两个控件是各自的控件集中唯一的 CommandBar 对象。
杂
运行时错误91 vba
ActiveWindow.Caption = ""
没有 ActiveWindow
声明一个Worksheet
对象变量和分配给它。
没有工作表
文件-选项-高级-此工作簿显示选项-显示工作表标签
报错,说endif没有if'块缺少End With
cbxMc.AddItem .Cells(i, 3) 'ad 要有个空格
代码listbox
listbox1.additem .cells(i,3) 在列表框listbox1中新增一行,该行第一列的值是sheets("图书资料")第i行,第3列的单元格值 listbox1.list(listbox1.listcount-1,1)= .cells(i,1) 在列表框listbox1中新增的那一行的第二列赋值为sheets("图书资料")第i行,第1列的单元格值
SumProduct
=SUMPRODUCT(E2:E16,F2:F16)
乘积+求和的功能正是SUMPRODUCT所专职扮演的,个参数的逐个元素依次相乘,最后将各个乘积的结果求和。
=E2*F2+E3*F3+E4*F4....E16*F16
Round
在VBA中Round函数是采用“银行家舍入”,
BA内置的Round函数在对数值进行四舍五入运算时实行的就是Bankre舍入,而不是算术舍入。按Bankre舍入规则,如果保留位数的下一个数字正好是5则其后没有其他有效数字,则按保留位最后一位“偶舍奇入”的方法进行处理。
要对A进行四舍五入,保留B位小数,Round(A 0.1^(B 2),B)
清除
With Worksheets("Sheet1")
.Range(.Cells(2, 1), .Cells(1048576, 16384)).ClearContents
End With
ClearContents是只清除内容的,不清除格式
排序
Range("a1:a10").Sort Key1:=Range("a1"), Order:=xlAscEnding 语句中“:=" 是什么含义
通常VBA参数的书写是有先后顺序的,用了:=后参数就可以不按先后顺序书写了,方便编写的人。
Range("a1:a10").Sort Order:=xlAscEnding ,Key1:=Range("a1")
比如Order和key1是sort 方法的属性。也就是排序时的关键字等相关的参数。
单元格
D5:
ActiveSheet.Cells(5, 4).Select 或:ActiveSheet.Range("D5").
A5 .Cells(5,1).
cstr
Cstr() 意思将括号内的数据转换为文本型
宏被禁止----- 解决办法
Office按钮, 右下角"excel 选项" ==>信任中心 ==>信任中心设置 ===>宏设置==> 设置成限制最小. 然后重新打开excel, 再试试vba, 发现就可以运行了. 但是注意安全性.
-
有人建议, 不要将常用vba存在每个excel的modle中, 存放在personal files中. 这样可以在各个excel中引用/运行.
#1219
Option Explicit 语句在模块级别中使用,强制显示声明模块中的所有变量。 如果模块中使用了 Option Explicit, 则必须使用 Dim、Private、Public、ReDim 或 Static 语句来显式声明所有的变量
xlformatfromleftorabove
这就是要按填充方向来决定选择哪个: 向右填充时,从左边的单元格复制格式。 向下填充时,从上边的单元格复制格式
粘贴
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False
上面语句的含义是:对选择的内容(Selection),执行PasteSpecial操作(选择性粘贴),粘贴的方式为数值,且不进行运算,不跳过空单元格,不转置,可参考选择性粘贴窗口的各个选项。
Application.CutCopyMode=false作用
在复制或者剪切了大量内容后关闭文件,如果不写上这句代码, 1、会出现提示窗口:是否保存手复制的内容到剪贴板,以便下次使用
单元格表示
Range("B10").End(xlUp)表示的就是在B列从第10行(不包含第10行)向上查找到的第一个有数据的单元格.
R2C3表示位于第2行、第3列的单元格
RC[-1],R[-1]C[-1]都是R1C1的单元格引用格式
R[-1]C 对当前单元格所在列中的上一行单元格的相对引用,即D4单元格。 R[5]C[2] 对当前单元格下面第5行、右面第2列的单元格的相对引用,即F10单元格。 R5C2 对当前工作表的第5行、第2列的单元格的绝对引用,相当于5。 R[-1] 对当前单元格上面一行区域的相对引用,相当于4:4。 R 对当前行的绝对引用,相当于5
简单代码例子
小的
考试成绩,计算体积,生日计算
计算平均成绩,计算年龄升序
冒泡排序,浮点数对比,回复yes
Range("J3:K3").Select
分年纪
一个学期参加青年阶段1课程,然后下个学期,他们的孩子会自动移动 提升水平尽管这是不正确的,因为要完成进度需要完成8个关键目标。 如果孩子不能将所有目标都达到令人满意的水平,则他们必须保持在该水平。
。如果孩子在该阶段完成了所有复选框,则他们 可以进入下一个阶段。但是,如果一切还没有完成,那么他们 必须在另一个任期内保持相同水平。对于此应用程序,仅青年阶段1,
日历
多个端的
A1输入100
Application.Worksheets( “ Sheet1 “ ).Range( “ A1 “ ).Value = 100
Application 代表 Excel 应用程序
Workbook 代表 Excel 中的工作簿,一个 Workbook 对象代表一个工作簿文件
Range 代表 Excel 中的单元格,可以是单个单元格,也可以是单元格区域
参考代码
# ‘MsgBox
Part = MsgBox("Please choose your part. Click Yes when", vbYesNoCancel, "Part of the module")
猜数字
Dim x
is equivalent to
Dim x As Variant
Dim sheet As s1
Example
Sub ShowDiscount()
Dim Price As Integer
Dim Discount As Double
Price = InputBox("Enter Price: ")
Select Case Price
Case 0 To 24
Discount = 0.1
Case 25 To 49
Discount = 0.15
Case 50 To 74
Discount = 0.2
Case Is >= 75
Discount = 0.25
End Select
MsgBox "Discount: " & Discount
End Sub
for_next
Private Sub ShadeofGreyEveryOtherRow()
Dim i As Long
For i = 1 To 300 Step 2
Rows(i).Interior.Color = RGB(200, 200, 200)
Next i
End Sub
do-while-loop
Dim lngCount As Long
lngCount = 1
Do While lngCount <= 10
MsgBox CStr(lngCount)
lngCount = lngCount + 1
Loop
do-while until
'Repeat the code while the condition is true
Do While i <= 10
your code
Loop
OR
Do
your code
Loop While i <= 10
'Repeat the code while the condition is false = until the condition becomes true
Do until i > 10
your code
Loop
OR
Do
your code
Loop Until i > 10
程序
Private Function HasPassed( _
ByVal lngPassedCourses As Long, _
ByVal dblAverage As Double) As Boolean
HasPassed = False
If lngPassedCourses < 4 Then
Exit Function
End If
If (lngPassedCourses < 6) And (dblAverage < 45.5) Then
Exit Function
End If
HasPassed = True
End Function
excel
3
Sub StatementsExample()
Dim Surname As String
Dim Forname As String
Surname = InputBox("What is your surname name?")
Forename = InputBox("What is your forename name?")
MsgBox ("I'm an oracle! Your name is " & Forename & " " & Surname)
End Sub
Private Sub A()
Dim strInput As String
Dim lngSqr As Long
strInput = "9.1"
lngSqr = strInput * strInput
MsgBox lngSqr
End Sub
Private Sub B()
Dim strInput As String
Dim lngAge As Long
Dim lngSqr As Long
strInput = "9.1"
lngAge = CLng(strInput)
lngSqr = lngAge * lngAge
MsgBox CStr(lngSqr)
End Sub
4
Private Sub AnnoyUser()
Dim Response As VbMsgBoxResult
Do
Response = MsgBox("Hi, I would like to state your name. Is your name John?", vbYesNo)
Loop Until Response = vbYes
MsgBox "See... I knew your name was John!?"
End Sub
‘vb
Sub NumberIsGreaterThan1()
Dim lngNumber As Long
lngNumber = InputBox("Input an integer of your choice")
If lngNumber < 0 Then
MsgBox "Number is less than 0?"
ElseIf 0 <= lngNumber And lngNumber <= 1 Then
MsgBox "Number between 0 and 1, inclusive"
Else
MsgBox "Number is greater than 1?"
End If
End Sub
‘颜色
Private Sub ShadeofGreyEveryOtherRow()
Dim i As Long
For i = 1 To 300 Step 2
Rows(i).Interior.Color = RGB(200, 200, 200)
Next i
End Sub
‘计算打折价格
Sub ShowDiscount()
Dim Price As Integer
Dim Discount As Double
Price = InputBox("Enter Price: ")
Select Case Price
Case 0 To 24
Discount = 0.1
Case 25 To 49
Discount = 0.15
Case 50 To 74
Discount = 0.2
Case Is >= 75
Discount = 0.25
End Select
MsgBox "Discount: " & Discount
End Sub
’先判断再决定酒吧
Option Explicit
Sub ShowUsYourAge()
Dim strAge As String
Dim dblAge As Double
Dim strDrink As String
strAge = InputBox("What is your age in years?")
dblAge = CDbl(strAge)
If dblAge < 16 Then
GoTo Underage:
Else
GoTo Whatsyourtipple:
End If
'Goto statements are below:
Underage:
MsgBox ("You are not old enough to drink. Please leave now")
End
Whatsyourtipple:
strDrink = InputBox("What can I get you?")
MsgBox (strDrink & " coming up!")
End
End Sub
‘比赛计分比较
'The following sub demonstrates nested loops, i.e. a loop within a loop
'First loop asks user to enter a Amount and if answer is no exits the loop
'Second loop is nesed within the first loop usind Do...until this loop asks user to keep entering values until user says no.
Sub CompareFootballScores()
Dim Team1Score As Long
Dim Team2Score As Long
Dim Relst As String
Dim Response As VbMsgBoxResult
Dim Response2 As VbMsgBoxResult
Response = MsgBox("This routine compares the scores of two football teams. Would you like to enter scores to compute the results?", vbYesNo, "Initial Amount Entry")
Do While Response = vbYes 'Loop 1 starts here
Do 'Loop 2, which is inside loop 1 starts, here ****.
Team1Score = InputBox("Enter Team A score: ")
Team2Score = InputBox("Enter Team B score: ")
If Team1Score > Team2Score Then
Result = "Team A won " & Team1Score & "-" & Team2Score
ElseIf Team2Score > Team1Score Then
Result = "Team B won " & Team2Score & "-" & Team1Score
Else
Result = "The match was drawn " & Team2Score & " all"
End If
MsgBox Result
Response2 = MsgBox("Would you like to enter more scores to compare?", vbYesNo, "Subsquent Amount Entry")
Loop Until Response2 = vbNo
Exit Do 'Loop 2 ends here. 'Exit do' is required to stop it ****
Loop 'End of loop 1
End Sub
#计算年龄
Option Explicit
Dim myDOB As Date
Private Function MyAge(ByVal myDOB As Date) As Double
MyAge = FormatNumber((Date - myDOB) / 365.25, 2)
End Function
Private Sub ShowAge()
Dim strAge As String
'Allow entry as a string for a little bit of flexibility
strAge = InputBox("What is your date of birth in dd/mm/yyyy format?", "Enter Date of Birth")
'Convert string into date value
myDOB = CDate(strAge)
'Now call the function has MyAge and display the age
MsgBox "Your age is " & MyAge(myDOB) & " years."
End Sub
各种基础
Option Explicit
'类型
Private Type Student 'Declare UDT called student
Name As String 'Notice the Type declaration is at the topic of the module, outside of any subs; this give it file scope
Age As Long
Height As Double
Course As String
End Type
Private Const lngNUMBERSTUDENTS = 4 'Declare a constant for the number of students; this allows us to run the same program easily with a different number of students other than 4
'------------------------------------------------------------------------------------
' Name: BubbleSortAscendingByAge
' Description: Bubble sort algorithm to sort students in ascending order by age and display the result.
'------------------------------------------------------------------------------------
Private Sub BubbleSortAscendingByAge()
Dim ArrayUdtStudent(1 To lngNUMBERSTUDENTS) As Student 'Declare an array, which contains data of the type student (cf. you could declared an array of double, string, or any other type; it just happens that the type in this case is UDT)
Dim OuterLoopIndex As Long 'OuterLoopIndex and InnerLoopIndex are variables to represent index numbers the array ArrayUdtStudent
Dim UdtTempStudent As Student 'Declare a variable of the UDT type student to temporarily hold data when values are swapped
Dim strOutput As String
' Populate the student array somehow
ArrayUdtStudent(1).Name = "Paul"
ArrayUdtStudent(1).Age = 21
ArrayUdtStudent(1).Height = 1.84
ArrayUdtStudent(1).Course = "Accounting"
With ArrayUdtStudent(2) 'Recall this structure leads to the same output as above regarding student names
.Name = "Liz"
.Age = 18
.Height = 1.52
.Course = "Business Analytics"
End With
With ArrayUdtStudent(3)
.Name = "Kate"
.Age = 20
.Height = 1.7
.Course = "Accounting and Finance"
End With
With ArrayUdtStudent(4)
.Name = "Jonathan"
.Age = 19
.Height = 1.72
.Course = "Business Management"
End With
'Bubble sort algorithm
For OuterLoopIndex = 1 To lngNUMBERSTUDENTS
For InnerLoopIndex = 1 To lngNUMBERSTUDENTS - 1
If ArrayUdtStudent(InnerLoopIndex).Age > ArrayUdtStudent(InnerLoopIndex + 1).Age Then 'If current student InnerLoopIndex age is older than the next in the list i.e. InnerLoopIndex + 1, then
UdtTempStudent = ArrayUdtStudent(InnerLoopIndex) 'Transfer current student data to be held temporarily by the temporary UDT UdtTempStudent
ArrayUdtStudent(InnerLoopIndex) = ArrayUdtStudent(InnerLoopIndex + 1) 'Now move student InnerLoopIndex + 1 data up the list into posistion InnerLoopIndex
ArrayUdtStudent(InnerLoopIndex + 1) = UdtTempStudent 'Then put values held by UdtTempStudent into position InnerLoopIndex + 1
End If
Next InnerLoopIndex 'Repeat nested to compare next pair of students
Next OuterLoopIndex
'Display students names and ages in ascending order
strOutput = "The students in ascending age are:"
For OuterLoopIndex = 1 To lngNUMBERSTUDENTS
strOutput = strOutput & vbNewLine & ArrayUdtStudent(OuterLoopIndex).Name & " is: " & ArrayUdtStudent(OuterLoopIndex).Age
Next OuterLoopIndex
MsgBox strOutput
End Sub
小代码
Sub 作业3_denglu_c()
Dim name As String, key As String '定义用户名name为string型变量,密码key为string型变量
Const tname As String = "小明", tkey As String = "888888"
'此处声明常量方便用户名和密码改变后的代码修改,tname表示正确的用户名,tkey表示正确密码
name = InputBox("请输入用户名") '提示输入用户名
Select Case name '用select case 语句进行选择判断
Case Is = tname '如果输入的用户名等于正确的用户名
key = InputBox("请输入密码") '提示输入密码
Select Case key
Case Is = tkey '如果输入的密码等于正确的密码
MsgBox "登录成功" '输出语句“登录成功”
Case Else '在用户名正确,密码错误的情况下
MsgBox "密码错误,登录失败" '输出语句"密码错误,登录失败"
End Select
Case Else '用户名不正确的情况下
MsgBox "用户名不存在" '输出语句“用户名不存在”
End Select
End Sub
Sub 排班表()
Dim arr(), i As Long, j As Long, r As Long, k As Long, day As Long
r = Range("a" & Rows.Count).End(xlUp).Row
arr() = Range(Range("a1"), Range("ag" & r))
j = 2
k = 1
For i = 2 To r
Do Until j > 32
If arr(i, j) <> "02" And arr(i, j) <> "*" And arr(i, j) <> "" Then
Do While arr(i, j + 1) <> "02" And arr(i, j + 1) <> "*" And arr(i, j + 1) <> ""
k = k + 1
j = j + 1
Loop
If k > day Then
day = k
End If
j = j + 1
k = 1
Else
j = j + 1
End If
Loop
If day > 7 Then
Range("ag" & i) = day
End If
j = 2
day = 0
Next
End Sub
Sub InsertMerge()
Dim sht As Worksheet, rows As Integer, i As Integer, n As Integer, m As Integer
n = Worksheets.Count - 1
For Each sht In Worksheets
If sht.Index > 1 Then
sht.Select
ActiveSheet.UsedRange.Select
Selection.Cut Range("B1")
Range("A1").Value = "账号"
rows = Selection.rows.Count
For i = 2 To rows
m = ((i - 2) Mod n) + 2
Range("A" & i).Value = Worksheets.Item(m).Name
Next
'MsgBox Selection.Address
If sht.Index = 2 Then
sht.UsedRange.Copy Worksheets.Item(1).Range("A65536").End(xlUp)
Else
sht.UsedRange.Offset(1, 0).Copy Worksheets.Item(1).Range("A65536").End(xlUp).Offset(1, 0)
End If
End If
Next
End Sub