txt文本用notepad打开正常，vba读取或excel打开 中文皆乱码．

qingwusigui

我试过，只能把txt用notepad打开，复制到另一个新的notepad中再另存，然后就可以．

    Open F For Input As #1
    s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)  
    Close #1


求解．谢谢拉

百度不到去谷歌

百度了一个函数 自己也收藏了 这个文章很多种处理utf-8的函数 很好很强大http://www.cnblogs.com/waver/articles/1283842.html
然后你读取文件的地方用这个函数代替即可 测试通过
    Application.StatusBar = "正在提取数据, 请稍候..."
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Open F For Input As #1
    s = Split(ReadUTF8(F), vbCrLf)  'vbfromunicode?

    Close #1
    ''''''''''''''

1. Public Function ReadUTF8(ByVal sUTF8File As String) As String
   
2.      If Len(sUTF8File) = 0 Or Dir(sUTF8File) = vbNullString Then Exit Function
   
3.      Dim ados As Object
   
4.      Set ados = CreateObject("adodb.stream")
   
5.      With ados
   
6.          .Charset = "utf-8"
   
7.          .Type = 2
   
8.          .Open
   
9.          .LoadFromFile sUTF8File
   
10.          ReadUTF8 = .ReadText
    
11.          .Close
    
12.      End With
    
13.      Set ados = Nothing
    
14. End Function

复制代码

zhaogang1960

输出到工作表，使用Transpose函数转置失败，用数组转置吧：

1. Private Sub CommandButton1_Click()
   
2.     Dim F, s$(), arr$(), i&
   
3.     F = Application.GetOpenFilename("文本文件(*.txt), *.txt,所有文件(*.*), *.*", , "请单选OMC导出的GSMNCELL邻区表文本")   '一次只打开一个文件,参数顺序不能变,第二个是索引留空
   
4.     s = Split(ReadUTF(F), vbCrLf)
   
5.     ReDim arr(0 To UBound(s), 1 To 1)
   
6.     For i = 0 To UBound(s)
   
7.         arr(i, 1) = s(i)
   
8.     Next
   
9.     Cells.ClearContents
   
10.     [a1].Resize(i) = arr
    
11. End Sub
    
12. 
    
13. Function ReadUTF(ByVal FileName As String) As String
    
14.     With CreateObject("ADODB.Stream")
    
15.         .Type = 2    '读取文本文件
    
16.         .Mode = 3   '读写
    
17.         .Open
    
18.         .LoadFromFile FileName
    
19.         .Charset = "UTF-8"  '设定编码
    
20.         .Position = 2
    
21.         ReadUTF = .ReadText
    
22.         .Close
    
23.     End With
    
24. End Function
    

复制代码

qingwusigui

百度不到去谷歌 发表于 2014-4-16 22:48
百度了一个函数 自己也收藏了 这个文章很多种处理utf-8的函数 很好很强大http://www.cnblogs.com/waver/art ...

多谢，一试就好OK。还有一个SaveFile函数，真不错

qingwusigui

zhaogang1960 发表于 2014-4-16 23:02
输出到工作表，使用Transpose函数转置失败，用数组转置吧：

多谢赵老师，连我后续工作都帮解决了，我要好好保存下来慢慢研究

chuxuezhe999

zhaogang1960 发表于 2014-4-16 23:02
输出到工作表，使用Transpose函数转置失败，用数组转置吧：

赵老师，您好

      请问，如果是要导入当期目录下的所有txt内容， 要如何处理？

例如：
1、有 100个文本文件。    从a1开始读入， 读入完毕1个文件后，再接着读入第二个文件。直至结束。
---
   相当于 打开  文件1， 黏贴到  excel表中，

  然后，再打开文件2， 黏贴到 excel表中刚才 文件1的后面

  ....


谢谢！ 非常谢谢大家百忙之中抽出时间，帮助别人。


例子附件1.zip (2.31 KB, 下载次数: 37)

2015-3-18 11:18 上传

点击文件名下载附件
例子

zhaogang1960

chuxuezhe999 发表于 2015-3-18 11:11
赵老师，您好

      请问，如果是要导入当期目录下的所有txt内容， 要如何处理？

请参考：

1. Sub Macro1()
   
2.     Dim f$, s$(), arr(1 To 60000, 1 To 1), i&, m&
   
3.     f = Dir(ThisWorkbook.Path & "\*.txt")
   
4.     While f > ""
   
5.         Open ThisWorkbook.Path & "" & f For Input As #1
   
6.         s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
   
7.         Close #1
   
8.         For i = 0 To UBound(s) - 1
   
9.             m = m + 1
   
10.             arr(m, 1) = s(i)
    
11.         Next
    
12.         f = Dir()
    
13.     Wend
    
14.     ActiveSheet.UsedRange.ClearContents
    
15.     [a1].Resize(m) = arr
    
16. End Sub
    

复制代码

chuxuezhe999

zhaogang1960 发表于 2015-3-18 16:23
请参考：

非常谢谢赵老师回复。
---

    附件的文件编码是 UTF-8，  直接用 7楼的代码的话， 引入到excel中，会出行乱码。   

刚才我试过3楼的代码，导入文本，不会出现乱码。

      只是，3楼的文件，只能导入1个。 我想在3楼的基础上， 可以修改成，直接导入 本目录下的所有txt文件里面的内容

chuxuezhe999

顶一下，请大家帮忙释疑

chuxuezhe999

请高手帮忙看看。

谢谢