同路径提取指定txt，按英文分号进行换行

lhj323323 · 发表于 2024-10-16 06:40

老师：

上传的附件里有详细的说明
同时，在模块1里，也有两组语句，但运行后，都会报错。

求助.rar (19.6 KB, 下载次数: 6)
快照4.png

老师如有空，请帮忙看看，先谢谢了

ykcbf1100 · 发表于 2024-10-16 07:10

本帖最后由 ykcbf1100 于 2024-10-16 09:29 编辑

更新一下，加个文件另存

ykcbf1100 · 发表于 2024-10-16 07:12

本帖最后由 ykcbf1100 于 2024-10-16 09:30 编辑

参与一下。。。

liulang0808 · 发表于 2024-10-16 07:19

Sub test1() '要报错

Arr = Split(ReadUTF(ThisWorkbook.Path & "\新建5.txt"), ";")
ReDim brr(1 To UBound(Arr) * 3)
m = 0
For i = 0 To UBound(Arr)
      ss = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Arr(i), "{", "\"), "，", ","), "。", "."), "？", ""), "?", ""), "COLORWHITE", "COLOR9009FF"), "CLOSE", "C"), "COLORGREEN", "COLOR7018FF"), Space(1), "")
      If Right(ss, 1) = ";" Then
         ss = Left(ss, Len(ss) - 1)
      End If
      xm = Split(ss, ";")
      For j = 0 To UBound(xm)
         m = m + 1
         brr(m) = xm(j)
      Next
Next
ActiveSheet.[a1].Resize(m) = WorksheetFunction.Transpose(brr)
Open ThisWorkbook.Path & "\新建6.txt" For Output As #1
Print #1, Join(brr, vbCrLf)
Close #1
End Sub
Function ReadUTF(ByVal FileName As String) As String
With CreateObject("ADODB.Stream")
      .Type = 2
      .Mode = 3
      .Open
      .LoadFromFile FileName
      .Charset = "UTF-8"
      .Position = 2
      ReadUTF = .ReadText
      .Close
End With
End Function

liulang0808 · 发表于 2024-10-16 07:19

不知道理解的对不对。。。。

chenjx80 · 发表于 2024-10-16 09:08

炒股靠指标，那么离亏损不远了！
远离股市！远离股市！远离股市！

超股靠指标离亏损不远了.gif

		自动登录	找回密码
密码			免费注册

[求助] 同路径提取指定txt，按英文分号进行换行