常规情况
Option Explicit
Sub 被观音带走()
Dim i As Long
Dim found As Boolean
found = False
i = 3
Do While Not found And Cells(i, 2) <> "" 'found为真且单元格非空,则继续循环
If InStr(Cells(i, 6), "观音") > 0 Then '内容含有观音的进行判断
Range(Cells(i, 2), Cells(i, 6)).Interior.Color = RGB(0, 255, 255) '找出区域进行涂色
found = Not found 'found 改为真,表示已经找到了第一个
End If
i = i + 1
Loop
End Sub
exit语句
直接跳出循环或子过程(函数)
退出 do while
exit do
退出 for
exit for
退出 sub
exit sub 不用等到 end sub
Option Explicit
Sub 被观音带走()
MsgBox "我来了"
Exit Sub
MsgBox "我走了"
End Sub
while wend 不能使用exit
只能跳出一层循环
goto语句
Option Explicit
Sub 被观音带走()
MsgBox "我来了"
GoTo 直接结束吧:
MsgBox "我走了"
直接结束吧: '冒号是要跳的位置
End Sub
goto一般少用,主要用来提示出错
Option Explicit
Sub 错误()
Dim i As Integer
i = Cells(3, 2)
On Error GoTo myerror:
i = i * 3
Cells(3, 3) = i
exit sub '如果没问题就正常运行,并且不会跳到myerror那里
myerror:
MsgBox "数据太大"
End Sub
判断日期
Sub 日期函数()
Dim i As Long
For i = 1 To 15
If IsDate(Cells(i, 1)) Then '判断是否为日期变量
Cells(i, 1) = DateAdd("d", 38, Cells(i, 1)) '是日期变量,在原有时间上延后38天
Cells(i, 2) = "这个是日期"
End If
Next i
End Sub
Sub 判断数值()
MsgBox IsNumeric(Cells(1, 1)) '注意函数拼写,判断是否为数字
End Sub
Sub typenametext()
Dim i
'不加.value,则返回结果是range
'必须加.value返回才是单元格中数值的类型
For i = 1 To 5
Cells(i, 2) = typename(Cells(i, 1).Value)
Next i
End Sub
只针对尾数为5,其余正常,因为怕累计误差过大
如果要用四舍五入,用VBA的round实现不了,需要调用excel函数的round才行
Sub a()
Dim b As Double, x As Double
x = 24.5
b = Application.WorksheetFunction.Round(x, 0)
'这样结果为25
MsgBox b
End Sub
或者是用int暴力四舍五入,当然针对的是整数
Sub intround()
Dim a As Integer, x As Double
x = 3.5
a = Int(x + 0.5)
MsgBox a
End Sub
给数据分类
Option Explicit
Sub 分类()
Dim t
t = Timer '记录初始时间
Dim i As Integer, j As Integer
Dim k As Integer, l As Integer, m As Integer, n As Integer
k = 1: l = 1: m = 1: n = 1
Dim r As Worksheet, w1 As Worksheet, w2 As Worksheet, w3 As Worksheet, w4 As Worksheet
'建立5个表用于赋值
Set r = Worksheets("原始导入数据")
Set w1 = Worksheets("所有数字")
Set w2 = Worksheets("所有日期")
Set w3 = Worksheets("所有逻辑值")
Set w4 = Worksheets("所有字符串")
For i = 1 To 20
For j = 1 To 16
If Trim(r.Cells(i, j)) <> "" Then '去掉空串,不然会以0计入数字中
'注意:必须写cells.Value!否则typeName是“Range”
If typename(r.Cells(i, j).Value) = "Double" Then
w1.Cells(k, 1) = r.Cells(i, j)
k = k + 1
ElseIf typename(r.Cells(i, j).Value) = "Date" Then
w2.Cells(l, 1) = r.Cells(i, j)
w2.Cells(l, 1) = CDate(w2.Cells(l, 1))
'需要转换为date,不然输出为数字
l = l + 1
ElseIf typename(r.Cells(i, j).Value) = "Boolean" Then
w3.Cells(m, 1) = r.Cells(i, j)
m = m + 1
ElseIf typename(r.Cells(i, j).Value) = "String" Then
w4.Cells(n, 1) = r.Cells(i, j)
n = n + 1
End If
End If
Next j
Next i
MsgBox "耗时为:" & Timer - t & "秒" '记录用时
End Sub
文本编码
Option Explicit
Sub 偏科()
Dim i As Integer, d As Integer, b As Integer, c As Integer
i = 4
Cells(1, 1) = d
Do While Cells(i, 2) <> ""
b = Asc(Mid(Cells(i, 3), 4, 1))
'从文本中取出ABCD,这里用了mid之后不要加双引号
'如果直接写 b=asc("A")要加双引号
c = Asc(Mid(Cells(i, 4), 4, 1))
Cells(i, 5) = b - c
i = i + 1
Loop
End Sub
Sub 换行()
Dim s As String
s = "你好" & Chr(13) & Chr(10) & "再见!"
'回车 换行 chr读取数字换asc码,asc()给字母换数字
MsgBox s
End Sub
生成字母表
Sub 编字母()
Dim i As Long
For i = 1 To 26
Cells(i, 1) = Chr(i + Asc("A") - 1)
Next i
End Sub