وارد کردن اطلاعات فایل های txt در یک صفحه کاری با استفاده از مایکرو
با سلام
من با دستگاهی آزمایش میکنم که نتایج آزمایشات را به صورت جدا هر آزمایش را یک ستون 5000 آرایه ای در یک فایل جداگانه تکست ذخیره میکند.
من نیاز به مایکرو داشتم تا فایل های تکست ایجاد شده را بازخوانی و به صورت خودکار اسم هر فایل را در اولین خانه ستون و آرایه ها را در زیر آن وارد کند و سپس فایل بعدی را به همین صورت در ستون بعدی درج کند.
در این رابطه یک مایکرو پیدا کردم ولی متاسفانه فقط تا مرحله وارد کردن اسم فایل در اولین خانه ستون پیش میرود و محتویات فایل را در زیر آن وارد نمی کند.
لطفاً دوستان برای رفع عیب کمک کنند.
با تشکر.
:
من با دستگاهی آزمایش میکنم که نتایج آزمایشات را به صورت جدا هر آزمایش را یک ستون 5000 آرایه ای در یک فایل جداگانه تکست ذخیره میکند.
من نیاز به مایکرو داشتم تا فایل های تکست ایجاد شده را بازخوانی و به صورت خودکار اسم هر فایل را در اولین خانه ستون و آرایه ها را در زیر آن وارد کند و سپس فایل بعدی را به همین صورت در ستون بعدی درج کند.
در این رابطه یک مایکرو پیدا کردم ولی متاسفانه فقط تا مرحله وارد کردن اسم فایل در اولین خانه ستون پیش میرود و محتویات فایل را در زیر آن وارد نمی کند.
لطفاً دوستان برای رفع عیب کمک کنند.
با تشکر.
:
کد:
Sub test()
Dim myDir As String, fn As String, ff As Integer, txt As String
Dim delim As String, n As Long, b(), flg As Boolean, x, t As Integer
myDir = "c:\test" '<- change to actual folder path
delim = vbTab '<- delimiter (assuming Tab delimited)
fn = Dir(myDir & "\*.txt")
Do While fn <> ""
Redim b(1 To Rows.Count, 1 To 1)
ff = FreeFile
Open myDir & "\" & fn For Input As #ff
Do While Not EOF(ff)
Line Input #ff, txt
x = Split(txt, delim)
If Not flg Then
n = n + 1 : b(n,1) = fn
End If
If UBound(x) > 0 Then
n = n + 1
b(n,1) = x(1)
End If
flg = True
Loop
Close #ff
flg = False
t = t + 1
ThisWorkbook.Sheets(1).Cells(1,t).Resize(n).Value = b
n = 0
fn = Dir()
Loop
End Sub
کامنت