提取多个TXT的指定内容放在EXCEL里

ykcbf1100

代码更新。。。

1. Sub ykcbf()  '//2024.4.12
   
2.     Application.ScreenUpdating = False
   
3.     Set fso = CreateObject("scripting.filesystemobject")
   
4.     Set sh = ThisWorkbook.Sheets("Sheet1")
   
5.     p = ThisWorkbook.Path & ""
   
6.     ReDim brr(1 To 50000, 1 To 15)
   
7.     On Error Resume Next
   
8.     For Each f In fso.GetFolder(p).Files
   
9.         If LCase(f.Name) Like "*.txt" Then
   
10.             fn = fso.GetBaseName(f)
    
11.             Set wb = Workbooks.Open(f, 0)
    
12.             With wb.Sheets(1)
    
13.                 zrr = .UsedRange
    
14.                 wb.Close
    
15.             End With
    
16.             For i = 5 To UBound(zrr)
    
17.                 st = WorksheetFunction.Trim(zrr(i, 1))
    
18.                 If InStr(zrr(i, 1), "|--") = 0 Then
    
19.                     b = Split(zrr(i, 1), "|")
    
20.                     If b(2) <> Empty And InStr(b(4), "TO Number") = 0 Then
    
21.                         m = m + 1
    
22.                         For x = 1 To 15
    
23.                             brr(m, x) = Trim(b(x))
    
24.                         Next
    
25.                     End If
    
26.                     brr(m, 8) = WorksheetFunction.Substitute(brr(m, 8), ".", "") / 1000
    
27.                     st = Replace(brr(m, 9), ".", "-")
    
28.                     brr(m, 9) = IIf(Left(st, 2) = "00", "", Format(st, "yyyy/m/d"))
    
29.                     st = Replace(brr(m, 12), ".", "-")
    
30.                     brr(m, 12) = IIf(Left(st, 2) = "00", "", Format(st, "yyyy/m/d"))
    
31.                     brr(m, 13) = IIf(Left(CDate(brr(m, 13)), 2) = "0:", "", brr(m, 13))
    
32.                     brr(m, 14) = IIf(Left(CDate(brr(m, 14)), 2) = "0:", "", brr(m, 14))
    
33.                 End If
    
34.             Next
    
35.         End If
    
36.     Next f
    
37.     With sh
    
38.         .UsedRange.Offset(3).ClearContents
    
39.         .[a2].Resize(m, 15) = brr
    
40.         .[a2].Resize(m, 15).Borders.LineStyle = 1
    
41.         .[a2].Resize(m, 15).Sort .[o2], 2
    
42.         r1 = .Cells(Rows.Count, 2).End(3).Row
    
43.         For i = r1 To 2 Step -1
    
44.             If .Cells(i, 2).Value <> Empty Then Exit For
    
45.             r = i - 1
    
46.         Next
    
47.         .UsedRange.Offset(r).Clear
    
48.         .Rows("2:4").Copy
    
49.         .Rows("5:" & r).PasteSpecial Paste:=xlPasteFormats
    
50.         Application.CutCopyMode = False
    
51.         .[q5].Select
    
52.     End With
    
53.     Application.ScreenUpdating = True
    
54. End Sub
    

复制代码

sampsonpon

ykcbf1100 发表于 2024-4-12 13:58
代码更新。。。

这里还是不对，原本是dd.mm.yyyy,我要的结果是yyyy/m/d,而您处理后结果好像是把它的日当成月了

ykcbf1100

sampsonpon 发表于 2024-4-14 22:16
这里还是不对，原本是dd.mm.yyyy,我要的结果是yyyy/m/d,而您处理后结果好像是把它的日当成月了

dd.mm.yyyy，这个格式你不说我怎么知道呢。

改好了。。。

sampsonpon

ykcbf1100 发表于 2024-4-15 07:41
dd.mm.yyyy，这个格式你不说我怎么知道呢。

改好了。。。

这里为什么不一样？啥区别？

ykcbf1100

代码上传论坛后，”\"会变成""，你知道就行。

sampsonpon

ykcbf1100 发表于 2024-4-16 10:28
代码上传论坛后，”\"会变成""，你知道就行。

老师，请帮我再看看，非常感谢！

ykcbf1100

sampsonpon 发表于 2024-4-16 11:43
老师，请帮我再看看，非常感谢！

关于第一点，我这里没有你说的情况。第2点，格式是你自己设置的，2~4行就是你设置格式的地方。关于第3点，因为有一些空行清除了，会留下一下空间，不用管它，对结果没影响。

sampsonpon

ykcbf1100 发表于 2024-4-16 13:07
关于第一点，我这里没有你说的情况。第2点，格式是你自己设置的，2~4行就是你设置格式的地方。关于第3点 ...

1、换了个附件，30/60/80它们还是没被转换过来，实际它们值是030/060/080
2、最后三行变成了两行，为什么？每次还是不要这最后三行为好。

ykcbf1100

sampsonpon 发表于 2024-4-16 14:47
1、换了个附件，30/60/80它们还是没被转换过来，实际它们值是030/060/080
2、最后三行变成了两行，为什 ...

应该可以了。。。

sampsonpon

ykcbf1100 发表于 2024-4-16 15:04
应该可以了。。。

转换结果已经没有问题，但首次刷新还会留一行尾巴，再次刷新才会彻底没有尾巴。
再次感谢老师！感谢论坛！