提取TXT文档中内容到EXCEL表中

lcb520

wxxydl 发表于 2024-3-20 11:13
给你做了一个

做的非常好，谢谢啦！

lcb520

gwjkkkkk 发表于 2024-3-20 11:35
参与一下。。。

非常感谢！

lcb520

lisongmei 发表于 2024-3-20 11:28
整着玩，上个python的

牛！！！！！！

lcb520

tanglf188 发表于 2024-3-20 11:21
参与一下

非常感谢！！！

lcb520

taller 发表于 2024-3-20 11:20

非常感谢！！！！！

lcb520

liulang0808 发表于 2024-3-20 11:17
附件内容供参考。。。。

非常感谢！！！！

lcb520

fzxba 发表于 2024-3-20 11:17

谢谢啦！！！！！！

ykcbf1100

凑个热闹了。。。

ykcbf1100

参与一下了。。。

1. Sub ykcbf()  '//2024.3.20
   
2.     Application.ScreenUpdating = False
   
3.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
4.     p = ThisWorkbook.Path & ""
   
5.     f = p & "epc_send.txt"
   
6.     zrr = Split(WorksheetFunction.Trim(ReadUTFText(f)), "^^")
   
7.     ReDim brr(1 To UBound(zrr), 1 To 2)
   
8.     For i = 0 To UBound(zrr)
   
9.         If zrr(i) <> Empty Then
   
10.             b = Split(zrr(i))
    
11.             m = m + 1
    
12.             brr(m, 1) = b(0)
    
13.             brr(m, 2) = b(1)
    
14.         End If
    
15.     Next
    
16.     With sh
    
17.         .UsedRange.Offset(1).Clear
    
18.         .[a1].Resize(1, 2).Interior.Color = 49407
    
19.         With .[a2].Resize(m, 2)
    
20.             .Value = brr
    
21.             .Borders.LineStyle = 1
    
22.             .HorizontalAlignment = xlCenter  '//列居中
    
23.             .VerticalAlignment = xlCenter
    
24.         End With
    
25.     End With
    
26.     Application.ScreenUpdating = True
    
27.     MsgBox "OK！"
    
28. End Sub
    
29. 
    
30. Function ReadUTFText(ByVal fn As String) As String
    
31.     With CreateObject("ADODB.Stream")
    
32.         .Type = 2
    
33.         .Mode = 3
    
34.         .Open
    
35.         .LoadFromFile fn
    
36.         .Charset = "UTF-8"
    
37.         .Position = 2
    
38.         ReadUTFText = .ReadText
    
39.         .Close
    
40.     End With
    
41. End Function
    

复制代码

roserice

导入文本 然后用   WRAPROWS函数