[حل شده] وارد کردن مقادیر یک فایل txt در اکسل

[ZAMEN58]

با سلام و عرض تبریک بمناسبت سال نو
من یک فایل txt دارم و می خواهم مقادیر آن را وارد اکسل نموده و یک سری فعالیت بر روی آن انجام دهم
من با دستور workbook.open این کار را انجام دادم ولی چون مقادیر عددی بوده و طول رشته بیش از 15 عدد می باشد بعد از ورود ،مقادیر از بین می رود
لطفا راهنمایی فرمایید

[ZAMEN58]

با سلام
من این کد را هم امتحان کردم ولی 935 ردیف را اعمال می کنه

Sub TextToExcel()
On Error Resume Next
Dim objFSO As FileSystemObject
Dim objTS As TextStream
Dim I, A, B, C As Long
Dim strFile As String
Dim PathName, Filename
Dim wbI As Workbook, wbO As Workbook
Dim wsI As Worksheet
PathName = Application.ActiveWorkbook.Path & "\"
Filename = "S.txt"
Application.ScreenUpdating = False
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFile = PathName & Filename
Columns("A:B").Select
Selection.NumberFormat = "@"
Range("A1").Select
If Len(Dir(strFile)) > 0 Then
Set objTS = objFSO.OpenTextFile(strFile, ForReading, False, TristateUseDefault)
Sheet1.Range("a1").Value = objTS.ReadAll
objTS.Close
End If
Application.ScreenUpdating = True
B = Len(Sheet1.Range("A1").Value)
I = Int(B / 33)
C = 1
For A = 1 To I
Sheets("Sheet1").Range("B" & A).Value = Mid(Sheet1.Range("A1").Value, C, 33)
C = C + 35
Next
Sheets("Sheet1").Range("A1").Clear.Content
End Sub 

[iranweld]

با سلام

ابتدا فرمت سل ستون مورد نظر را به text تغییر بدید

کل محتویات فایل text را انتخاب و با ctrl+c در حافظه کپی نمایید و بر روی یکی از سلولهای ستون مورد نظر paste نمایید

[ZAMEN58]

با کد زیر مشکل حل شد

Option Explicit
Sub ReadTextintoExcel()
On Error Resume Next
Dim objFSO As FileSystemObject
Dim objTS As TextStream
Dim A, B As Long
Dim strFile As String
Dim wbI As Workbook, wbO As Workbook
Dim wsI As Worksheet
strFile = Application.ActiveWorkbook.Path & "\S.txt"
Application.ScreenUpdating = False
Set objFSO = CreateObject("Scripting.FileSystemObject")
Range("A:A").NumberFormat = "@"
Range("A1").Select
If Len(Dir(strFile)) > 0 Then
Set objTS = objFSO.OpenTextFile(strFile, ForReading, False, TristateUseDefault)
objTS.ReadAll
A = objTS.Line
objTS.Close
Set objTS = objFSO.OpenTextFile(strFile, ForReading, False, TristateUseDefault)
For B = 1 To A
Sheet1.Range("A" & B).Value = objTS.Read(33)
objTS.SkipLine
Next
objTS.Close
End If
Application.ScreenUpdating = True
End Sub