请教下VBA提取TXT文件时的乱码问题

IE_Crayon

如图，Left（s，2）为什么返回的是"鍏ㄩ"？右侧是目标文件，文字内容是手打的。

skiss

中文，应该是UTF8的格式吧

ykcbf1100

楼主上附件看一下。

客非

应该是哪里的编码不匹配了

IE_Crayon

skiss 发表于 2024-5-21 16:29
中文，应该是UTF8的格式吧

那需要怎么处理啦？

IE_Crayon

ykcbf1100 发表于 2024-5-21 17:03
楼主上附件看一下。

好，附件上传了，麻烦了

gwjkkkkk

Option Explicit
Sub TEST()
    Dim ar$(), i&, n&, strTxt$, strPath$, strFileName$
   
    strPath = ThisWorkbook.Path & "\"
    strFileName = strPath & "\客户信息.txt"
    If strFileName = "" Then Exit Sub
   
    Application.ScreenUpdating = False
   
    Cells.Clear
    strTxt = ReadFromTextFile(strFileName)
    ar = Split(strTxt, vbLf)
    For i = 0 To UBound(ar)
        If Left(ar(i), 2) = "北京" Then
            n = n + 1
            Cells(n, 1).Value = ar(i)
        End If
    Next i
   
    Application.ScreenUpdating = True
    Beep
End Sub

Function ReadFromTextFile$(ByVal strFullName$, _
    Optional ByVal strCharSet$ = "UTF-8")
   
    With CreateObject("ADODB.Stream")
        .Type = 2
        .Mode = 3
        .Charset = strCharSet
        .Open
        .LoadFromFile strFullName
        ReadFromTextFile = .ReadText
        .Close
    End With
End Function

gwjkkkkk

,,,,,,,,,,,,

ykcbf1100

IE_Crayon 发表于 2024-5-21 17:13
好，附件上传了，麻烦了

TXT文件读入。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.21
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     p = ThisWorkbook.Path & ""
   
6.     f = p & "\客户信息.txt"
   
7.     zrr = Split(ReadUTFText(f), Chr(13))
   
8.     ReDim brr(1 To 1000, 1 To 2)
   
9.     m = 1
   
10.     brr(1, 1) = zrr(0)
    
11.     For i = 1 To UBound(zrr)
    
12.         If zrr(i) <> Empty Then
    
13.             s = WorksheetFunction.Trim(zrr(i))
    
14.             b = Split(s, "，")
    
15.             If InStr(b(0), "北京") Then
    
16.                 m = m + 1
    
17.                 brr(m, 1) = b(0)
    
18.                 brr(m, 2) = b(1)
    
19.             End If
    
20.         End If
    
21.     Next
    
22.     [e1].Resize(m, 2) = brr
    
23.     Application.ScreenUpdating = True
    
24.     MsgBox "OK！"
    
25. End Sub

复制代码