编写VBA程序,从文本文档中读取数据到Excel表格中,在复制入另一个文本文档中

有一文本文件内容如下图所示:
股票代码 昨日收盘 今日收盘
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第一个工作簿中就行了

img

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