EXCEL提取文本字符到EXCEL单元格

冰冰189

麻烦老师帮忙写个VBA代码，将TXT文件的字符提取到EXCEL单元格内，详见附加文件，谢谢！

ykcbf1100

没搞懂，为啥要把所有字符都放在一个单元格中呢？按行存放不是更合理吗？

liulang0808

https://club.excelhome.net/threa ... tml?_dsign=73cffde5
遍历文件的资料，然后打开txt文件，可以使用mid函数根据长度提取。
txt文件注意下文件编码方式，然后决定使用什么方式打开的。
论坛资料很多，楼主可以检索参考下

冰冰189

ykcbf1100 发表于 2025-1-15 12:02
没搞懂，为啥要把所有字符都放在一个单元格中呢？按行存放不是更合理吗？

老师，没有说只放在一个单元格 从列，C2单元格开始，每个单元格放1万个字符 超过10000个字符 ，放到D2单元格，依次类推送，直到把所有字符放完，每遍历一个文本自动换行，谢谢。

冰冰189

liulang0808 发表于 2025-1-15 12:28
https://club.excelhome.net/thread-1258425-1-1.html?_dsign=73cffde5
遍历文件的资料，然后打开txt文件 ...

谢谢老师的指导

ykcbf1100

冰冰189 发表于 2025-1-15 12:30
老师，没有说只放在一个单元格 从列，C2单元格开始，每个单元格放1万个字符 超过10000个字符 ，放到D2单 ...

那空行算不算？

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf2()   '//2025.1.15
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("Scripting.FileSystemObject")
   
5.     p = ThisWorkbook.Path & "\txt文件"
   
6.     Set sh = ThisWorkbook.Sheets("测试")
   
7.     ReDim brr(1 To 10000, 1 To 100)
   
8.     num = 10000
   
9.     On Error Resume Next
   
10.     Dim tm: tm = Timer
    
11.     For Each f In fso.GetFolder(p).Files
    
12.         If f.Name Like "*.txt" Then
    
13.             Set wb = Workbooks.Open(f, 0)
    
14.             m = m + 1
    
15.             brr(m, 1) = m
    
16.             brr(m, 2) = f.Name
    
17.             With wb.Sheets(1)
    
18.                 r = .UsedRange.Find("1.0 Purpose").Row
    
19.                 arr = .UsedRange.Offset(r - 1).Value
    
20.                 st = .Cells(r, 1).Value
    
21.             End With
    
22.             wb.Close 0
    
23.             For i = 2 To UBound(arr)
    
24.                 st = st & arr(i, 1)
    
25.             Next
    
26.             k = Application.Ceiling(Len(st) / num, 1)
    
27.             For x = 1 To k
    
28.                 If x = k Then
    
29.                     brr(m, x + 2) = Mid(st, (k - 1) * num + 1)
    
30.                 Else
    
31.                     brr(m, x + 2) = Mid(st, (x - 1) * num + 1, num)
    
32.                 End If
    
33.             Next
    
34.             Max = IIf(Max < k, k, Max)
    
35.         End If
    
36.     Next
    
37.     With sh
    
38.         .UsedRange.Offset(1).Clear
    
39.         .[a2].Resize(m, Max + 2) = brr
    
40.     End With
    
41.     Application.ScreenUpdating = True
    
42.     MsgBox "共用时：" & Format(Timer - tm) & "秒！"
    
43. End Sub
    

复制代码

冰冰189

ykcbf1100 发表于 2025-1-15 14:25
参与一下。。。

老师非常正确，谢谢