全民一起VBA提高篇第二课：基本数据类型详解二

常规情况

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