请 老师修改 代码

8901392

Cells(c, 4)  =  ReadUTF(f)  出现乱码

Sub 按钮1_Click()
    Set fso = CreateObject("scripting.filesystemobject")
    Application.ScreenUpdating = False
    r = 2
    For Each f In fso.getfolder(ThisWorkbook.Path).Files
        If InStr(f.Name, ".txt") > 0 Then

            For c = 2 To 1000
            If Cells(c, 1) = Split(f.Name, ".txt")(0) Then Cells(c, 4) = ReadUTF(f)
           Next
            r = r + 1
        End If
    Next f
    Application.ScreenUpdating = True
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



求助附件.rar (12.32 KB, 下载次数: 7)

2019-12-13 21:58 上传

点击文件名下载附件

8901392

自己顶下，

风筝那根线

改了一下编码

1. Sub 按钮1_Click()
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     r = 2
   
5.     For Each f In fso.getfolder(ThisWorkbook.Path).Files
   
6.         If InStr(f.Name, ".txt") > 0 Then
   
7.             
   
8.             For c = 2 To 1000
   
9.                 If Cells(c, 1) = Split(f.Name, ".txt")(0) Then Cells(c, 4) = ReadUTF(f)
   
10.             Next
    
11.             r = r + 1
    
12.         End If
    
13.     Next f
    
14.     Application.ScreenUpdating = True
    
15. End Sub
    
16. Function ReadUTF(ByVal FileName As String) As String
    
17.     With CreateObject("ADODB.Stream")
    
18.         .Type = 2
    
19.         .Mode = 3
    
20.         .Open
    
21.         .LoadFromFile FileName
    
22.         .Charset = "gbk"
    
23.         .Position = 2
    
24.         ReadUTF = .ReadText
    
25.         .Close
    
26.     End With
    
27. End Function

复制代码

liulang0808

楼主可以录制一段宏，用excel打开文本文件然后处理的
打开后是正常字符即可。不过效率能偏低一些

8901392

风筝那根线 发表于 2019-12-14 01:43
改了一下编码

太感谢了，思考好久的问题终于解决了。