求助关于txt文件导入excel

风过天涯

想要根据条件将txt文本文件不同行数的字符串内容，写进一个单元格，附件已上传，已重新上传附件谢谢

Peny2020

我在用的一个代码，去指定TXT文件里把第32行的数据放到D9单元格里。
你改一改，看能用不

Sub D()
Dim filepath As String
Dim FSO As Object
Dim stext As String
Dim arrtext() As String
T = ActiveWorkbook.Name
filepath = "Z:\DownloadVL06O.txt"
Set FSO = CreateObject("scripting.filesystemObject")
stext = FSO.OpenTextFile(filepath).ReadAll()
arrtext() = Split(stext, vbCrLf)
Workbooks(T).Sheets("GuiXT_Script").Range("d9") = Split(arrtext(32), "&")(1)
End Sub

fzxba

1. Sub test() '这个意思?我是猜的
   
2.   Dim i As Long, j As Long, n As Byte
   
3.   Dim p As String, f As String, s As String, t As String
   
4.   Application.ScreenUpdating = False
   
5.   p = ThisWorkbook.Path & "\"
   
6.   f = Dir(p & "*.txt")
   
7.   While Len(f)
   
8.     i = i + 1
   
9.     n = FreeFile
   
10.     Open p & f For Input As #n
    
11.     s = StrConv(InputB(LOF(n), #n), vbUnicode)
    
12.     Close #n
    
13.     t = Split(f, ".txt")(0) & String(2, Chr(32))
    
14.     With Sheet1.Range("D1")
    
15.       .Offset(i, 0) = t
    
16.       .Offset(i, 1) = "OK"
    
17.     End With
    
18.     s = t & Replace(s, vbCrLf, vbCrLf & t)
    
19.     Sheet2.Range("I1").Offset(i) = s
    
20.     f = Dir
    
21.   Wend
    
22.   Application.ScreenUpdating = True
    
23.   Beep
    
24. End Sub

复制代码

风过天涯

fzxba 发表于 2024-2-22 11:53

谢谢，大佬我是希望序号对应的信息放在同一个单元格，当出现下一个序号的时候循环到下一个单元格

fzxba

风过天涯 发表于 2024-2-22 12:31
谢谢，大佬我是希望序号对应的信息放在同一个单元格，当出现下一个序号的时候循环到下一个单元格

补充描述也好像不是你模拟的结果呢。

风过天涯

fzxba 发表于 2024-2-22 13:03
补充描述也好像不是你模拟的结果呢。

那是原来代码跑出来的效果

fzxba

风过天涯 发表于 2024-2-22 13:04
那是原来代码跑出来的效果

你有模拟效果，这可能容易。

风过天涯

fzxba 发表于 2024-2-22 13:06
你有模拟效果，这可能容易。

我是说需求有变动了，我想改动原来的代码去实现现有的需求，无从下手，唉

ykcbf1100

速度会慢点，但文件少，应该能接受吧。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.2.22
   
2.     Set Fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Set sh = ThisWorkbook.Sheets("结果")
   
5.     p = ThisWorkbook.Path & ""
   
6.     ReDim brr(1 To 10000, 1 To 2)
   
7.     For Each f In Fso.GetFolder(p).Files
   
8.         If f.Name Like "*.txt" Then
   
9.             fn = Fso.GetBaseName(f)
   
10.             Set wb = Workbooks.Open(f, 0)
    
11.             With wb.Sheets(1)
    
12.                 arr = .UsedRange
    
13.                 wb.Close False
    
14.             End With
    
15.             For i = 1 To UBound(arr)
    
16.                 If arr(i, 1) <> Empty Then
    
17.                     m = m + 1
    
18.                     brr(m, 1) = fn
    
19.                     brr(m, 2) = arr(i, 1)
    
20.                 End If
    
21.             Next
    
22.         End If
    
23.     Next f
    
24.     With sh
    
25.         .Cells.ClearContents
    
26.         .[a1].Resize(m, 2) = brr
    
27.     End With
    
28.     Application.ScreenUpdating = True
    
29.     MsgBox "OK！"
    
30. End Sub
    

复制代码