有一文本文件内容如下图所示:
股票代码 昨日收盘 今日收盘
000001 23.02 24.53
000002 34.53 37.54
000003 8.65 8.12
000004 3.45 3.47
000005 12.05 13.23
000006 32.56 32.56
000007 15.65 15.78
编写VBA程序,从该文本文件中读入数据到Excel的三个数据列中,并自动生成一列“方向“,其取值根据今日和昨日收盘价生成,分别为“上涨”,“下跌“,“持平”。然后将数据输出到另外一个文本文件中保存。
用Scripting.FileSystemObject对象读取text文件后split下得到行在遍历行写入当前运行vba的xlsm第一个工作簿中就行了
Function readText(path, charset) '读文件
Set ts = CreateObject("adodb.stream")
ts.charset = charset '内容编码
ts.Mode = 3 '读写模式
ts.Type = 2 '文本模式
ts.Open
ts.LoadFromFile path
readText = ts.readText
ts.Close: Set ts = Nothing
End Function
Function writeText(path, charset, text) '写文件
Set ts = CreateObject("adodb.stream")
ts.Mode = 3 '写写模式
ts.Type = 2 '文本模式
ts.Open
ts.charset = charset '内容编码
ts.writeText text, 1
ts.SaveToFile path, 2
ts.Close: Set ts = Nothing
End Function
Sub readtxt()
txtPath = "D:\vba\读取text写入sheet并导出\data.txt" '注意修改数据文件路径
Range("A1:A65535").NumberFormat = "@"
s = readText(txtPath, "utf-8")
arr = Split(s, vbNewLine)
For i = 0 To UBound(arr)
Item = Split(arr(i), " ")
ThisWorkbook.Sheets(1).Cells(i + 1, "A") = Item(0)
ThisWorkbook.Sheets(1).Cells(i + 1, "B") = Item(1)
ThisWorkbook.Sheets(1).Cells(i + 1, "C") = Item(2)
If i = 0 Then '写入表头
ThisWorkbook.Sheets(1).Cells(i + 1, "D") = "方向"
arr(i) = arr(i) & " 方向" '''''''''加入表头到当前数据行
Else '数据行
y = CDbl(Item(1))
t = CDbl(Item(2))
s = "下跌"
If t = y Then
s = "持平"
ElseIf t > y Then
s = "上涨"
End If
arr(i) = arr(i) & s '''''''''加入方向到当前数据
ThisWorkbook.Sheets(1).Cells(i + 1, "D") = s
End If
Next
'join下写回新文件中
s = Join(arr, vbNewLine)
newtxtPath = "D:\vba\读取text写入sheet并导出\result.txt" '注意修改结果路径
writeText newtxtPath, "utf-8", s '写回文件
End Sub