Lỗi khi muốn nhập dữ liệu .txt vào excel bằng lệnh macro

vubaduc1993

Thành viên mới
Tham gia ngày
10 Tháng mười một 2017
Bài viết
23
Được thích
0
Điểm
163
Tuổi
25
em muốn tạo lệnh macro trong excel tự động lấy dữ liệu file .txt ở thư mục vào excel
giả sử em muốn auto nhập ô A1 - lấy dữ liệu file data.txt ở thư mục ổ E - file data chỉ có 3 dòng thôi - nhưng em muốn tạo nút tắt để tự động nhập vào A1 ở các sheet thôi
không hiểu tạo sao khi em stop và nhập lại thì hiện run-time error '5' :
Sub rad()
'
' rad Macro
'
' Keyboard Shortcut: Ctrl+r
'
With ActiveSheet.QueryTables.Add(Connection:="TEXT;E:\data.txt", Destination _
:=Range("$A$1"))
.CommandType = 0
.Name = "data"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1258
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

bác nào có cách sửa được không hay làm cách khác được không thì chỉ em tí
 

LEHOC

Thành viên mới
Tham gia ngày
11 Tháng một 2017
Bài viết
46
Được thích
0
Điểm
163
Đính kèm 1 file excel kết quả & file txt ban đầu lên đây ắc có nhiều giải pháp cho bạn.
Em có 1 vấn đề tương tự, mong các anh/chị giúp đỡ em ạ.
Em cảm ơn.
Em bị lỗi Run-time erro '5': Invalid Procedure Call or Argument tại dòng 51
PHP:
.CommandType = 0
Của Sub sau:
PHP:
Sub ImportTextFiles()
Dim index As Long, r As Long, c As Long, n As Long, linecount As Long, text As String
Dim Rng As Range, fso As Object, ts As Object, Arr(), files, lines, items
    files = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
    If IsArray(files) Then
        Sheet1.Range("A1:A65536").EntireRow.Delete
        Set Rng = Sheet1.Range("A1")
        Set fso = CreateObject("Scripting.FileSystemObject")
        For index = LBound(files) To UBound(files)
'            n = 0
            n = 1
            Set ts = fso.OpenTextFile(files(index), 1, , -2)
            lines = Split(ts.ReadAll, vbCrLf)
            linecount = UBound(lines)
            With ActiveSheet.QueryTables.Add(Connection:="TEXT;ts", Destination:=Range("$A$" & n))
                .CommandType = 0
'                .Name = "3D  19993"
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = 65001
                .TextFileStartRow = 1
                .TextFileParseType = xlFixedWidth
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = True
                .TextFileSemicolonDelimiter = False
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False
                .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
                .TextFileFixedColumnWidths = Array(12, 46, 7, 5, 36, 17, 10, 12, 15, 37)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
            End With
            n = n + linecount
        Next index
        Set ts = Nothing
        Set fso = Nothing
   
        ThisWorkbook.Save
    End If
End Sub
Trong code trên em muốn dòng sau sẽ lấy tên theo file mà vòng For đang chạy thì phải làm sao ạ.
PHP:
.Name = "3D 19993"
Link file để Import ạ:
file 1
file 2
 
Lần chỉnh sửa cuối:
Top