麻辣家族討論版版 - Powered by Discuz! Board

Sub Ex()
Dim ar()
fd = ThisWorkbook.Path & "\"
fs = Dir(fd & "*.txt")
Do Until fs = ""
Open fd & fs For Input As #1
Do Until EOF(1)
Line Input #1, mystr
If mystr <> "" Then
a = Split(mystr, "=")
If a(0) = "SERIAL" Then r = a(1)
If a(0) = "SPEC" Then p = a(1)
If a(0) = "Total QTY" Then t = a(1)
If InStr(a(0), "SUPPLY") > 0 Then y = a(1)
If InStr(a(0), "QTY-") > 0 Then q = a(1)
If r <> "" And p <> "" And t <> "" And y <> "" And q <> "" Then
ReDim Preserve ar(s)
ar(s) = Array(r, p, t, y, q)
s = s + 1
y = "": q = ""
End If
End If
Loop
Close #1
fs = Dir
Loop
[A65536].End(xlUp).Offset(1, 0).Resize(s, 5) = Application.Transpose(Application.Transpose(ar))
End Sub

複製代碼