全民一起VBA提高篇第三课：字符串与文件

大写小写汉字转换

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