大写小写汉字转换
Sub Exercise1()
Dim i As Integer, j As Integer, k As String, s As String
Dim cn(10) As String
' cn(10)代表最大下标为10，不是数组长度
cn(0) = "零": cn(1) = "壹": cn(2) = "贰": cn(3) = "叁": cn(4) = "肆"
cn(5) = "伍": cn(6) = "陆": cn(7) = "柒": cn(8) = "捌": cn(9) = "玖"
k = CStr(Range("b5"))
'强制转换为字符串
s = ""
For i = 1 To Len(k)
j = CInt(Mid(k, i, 1))
'分别取出每一位数字
s = s & cn(j)
Next i
Range("c5") = s
End Sub
dim a(3 to 6)
'最小下标为3，最大为6，这个数组没有a(0)
防止出现越界错误
for i = lbound(a) to ubound(a)
拆解字符串
用字符串函数
Sub 分列()
Dim first As Long, last As Long, name As String
Dim i As Long, k As String
k = Trim(Cells(3, 2)) '清理好数据
i = 3
first = 0
Do While first < Len(k) '检查
last = InStr(first + 1, k, ",")
'返回一个字符串在另一个字符串中首次出现的位置
If last > 0 Then
name = Mid(k, first + 1, last - first - 1)
'取出两个分割符号之间的字符
If Trim(name) <> "" Then
Cells(i, 4) = name
i = i + 1
'把结果写出来
End If
first = last
'跳出循环
Else
Cells(i, 4) = Mid(k, first + 1)
'写最后一个
Exit Do
End If
Loop
End Sub
用split函数
Sub 分列2()
Dim a() As String, i As Long, k As Long
a = Split(Cells(3, 2), ",")
'用逗号分割，注意输入中文逗号用中文逗号，英文用英文
k = 3
For i = LBound(a) To UBound(a)
'找出上下界
Cells(k, 4) = a(i)
k = k + 1
Next i
End Sub
或者
Sub 分列3()
Dim a() As String, i As Long, x
'申请动态数组
a = Split(Cells(3, 2), ",")
'用逗号分割，注意输入中文逗号用中文逗号，英文用英文
i = 3
For Each x In a
'用each来找
'x必须用变体，哪怕知道他的类型，因为是数组
Cells(i, 4) = x
'用x赋值了
i = i + 1
Next x
End Sub
重新给动态数组定界
Sub 动态数组案例()
Dim a() As String
k = Cells(4, 2)
ReDim a(k)
MsgBox UBound(a)
End Sub
空字符串
如果用split会给你切分得很细，有可能有空字符串，都会切出来
Sub 非空字符串原始()
Dim a() As String, i As Long, x
i = 1
a = Split(Cells(3, 2), ",")
'只有定义数组才用a()，其余用a
For Each x In a
Cells(i, 3) = x
MsgBox Cells(i, 3)
i = i + 1
Next x
End Sub
Sub 非空字符串改进()
Dim a() As String, i As Long, x
Dim b() As String
i = 1
a = Split(Cells(3, 2), ",")
'只有定义数组才用a()，其余用a
For Each x In a
If x <> "" Then i = i + 1
Next x
ReDim b(i - 1)
'因为b(i)是指上界为i，实际空间给了i+1个
i = 0
For Each x In a
If x <> "" Then
b(i) = x
MsgBox b(i)
i = i + 1
End If
Next x
End Sub
对文本文件进行操作
读取文件
Option Explicit
Sub 读取练习()
Dim s As String, i As Long
Open "G:\网课\杨洋VBA\提高篇第11回课堂演示-2\客户信息.txt" For Input As #1
'给每个打开的文件一个数字编号
'打开一个文件
i = 1
Do While Not EOF(1)
'判断文本是否读完
Line Input #1, s
If Left(s, 2) = "北京" Then
'用于条件筛选
Cells(i, 1) = s
i = i + 1
End If
Loop
Close #1
'关闭保存
End Sub
写入文件
把三个excel工作簿中的信息汇总到一个txt里面
Sub 写入练习()
Dim s As String, i As Long
Dim w As Worksheet
Open "G:\网课\杨洋VBA\提高篇第11回课堂演示-2\客户信息.txt" For Output As #1
For Each w In Worksheets
i = 3
Do While Trim(w.Cells(i, 2)) <> ""
Print #1, w.Cells(i, 2); "--"; w.Cells(i, 3)
i = i + 1
Loop
Next w
Close #1
'每一行print结束没有分号，默认换行，给个分号，接着一行
End Sub
文本文件补充练习
本练习是为学习《提高篇》第11回的同学所设计，请编写程序，运行后将所附文本文件（销量.txt）的数据读入左表，读入时要求使用Split函数对每行内容按空格进行拆分，然后依次写入左表。
Option Explicit
Sub 读取练习()
Dim s As String, i As Long, j As Long
Dim x
Dim a() As String
Open "G:\网课\杨洋VBA\提高篇练习-第11回-161126\销量.txt" For Input As #1
'给每个打开的文件一个数字编号
'打开一个文件
i = 6
Do While Not EOF(1)
'判断文本是否读完
Line Input #1, s
If Asc(Left(s, 1)) >= 65 And Asc(Left(s, 1)) <= 91 Then
'用于条件筛选,目的在于去掉第一行部门/月份
a = Split(s, " ")
j = 2
For Each x In a
If x <> "" Then
'这个地方循环不能对j进行for循环，因为找不到放的位置
Cells(i, j) = x
j = j + 1
End If
Next x
i = i + 1 '放在循环里面累加，不需要用for
End If
Loop
Close #1
'关闭保存
'统计大于4500的和小于4500的，并把结果写入表格中
count1 = 0
count2 = 0
For i = 6 To 32
For j = 3 To 15
If Cells(i, j) >= 4500 Then
count1 = count1 + 1
ElseIf Cells(i, j) < 4500 And Cells(i, j) >= 0 Then
count2 = count2 + 1
Cells(i, j).Font.Color = vbRed
End If
Next j
Next i
Cells(7, 16) = count2 & "条"
Cells(9, 16) = count1 & "条"
End Sub
扫描文件夹
dir 返回文件名
Sub dirdemo()
Dim f As String
f = Dir("G:\网课\杨洋VBA\提高篇12回演示文件夹\d\demo2\")
'用f接收文件名
Do While f <> ""
Call readfile("G:\网课\杨洋VBA\提高篇12回演示文件夹\d\demo2\" & f)
'写成子程序便于调用
f = Dir
Loop
End Sub
Sub readfile(fullname As String)
Dim ws As Worksheet, i As Long, s As String
Set ws = Worksheets.Add
'追加新建文件夹
ws.Name = Mid(fullname, InStrRev(fullname, "\") + 1)
'文件夹的名字用读取的文件名来写，包括后缀名,这里读取的是
'文件夹下的所有文件
Open fullname For Input As #1
i = 1
Do While Not EOF(1)
Line Input #1, s
ws.Cells(i, 2) = Left(s, 2)
ws.Cells(i, 3) = Mid(s, InStr(s, "电话") + 3, 8)
'只读取电话后面的，然后取8位
i = i + 1
Loop
Close #1
End Sub
只要某种类型的文件
f = Dir("G:\网课\杨洋VBA\提高篇12回演示文件夹\d\demo2\")
改写为
f = Dir("G:\网课\杨洋VBA\提高篇12回演示文件夹\d\demo2\*.txt")
f = Dir("G:\网课\杨洋VBA\提高篇12回演示文件夹\d\demo2\a*.txt")
'首字母为a
用通配符*可破
判断文件夹下是否有某个文件
'接受主程序传来的文件名，然后打开并读入
Sub readfile(fullname As String)
'打开传来的文件名之前，先判断是否存在
If Dir(fullname) <> "" Then
Open fullname For Input As #1
'可以用来正常处理文件
Close #1
Else
MsgBox "不存在文件"
End If
End Sub
检索子文件夹的名字
Sub 子文件夹()
Dim f As String
f = Dir("G:\网课\杨洋VBA\提高篇12回演示文件夹\d\demo2\", vbDirectory)
'用于读取子文件夹，只返回一层
Do While f <> ""
MsgBox f
f = Dir
Loop
End Sub
