Note: The other languages of the website are Google-translated. Back to English

Làm cách nào để nhập nhiều tệp văn bản từ một thư mục vào một trang tính?

Đối với các trường hợp, ở đây bạn có một thư mục có nhiều tệp văn bản, những gì bạn muốn làm là nhập các tệp văn bản này vào một trang tính duy nhất như hình minh họa bên dưới. Thay vì sao chép lần lượt từng tệp văn bản, có thủ thuật nào để nhập nhanh tệp văn bản từ một thư mục vào một trang tính không?

Nhập nhiều tệp văn bản từ một thư mục vào một trang tính duy nhất với VBA

Nhập tệp văn bản vào ô hiện hoạt với Kutools cho Excel ý kiến ​​hay3


Đây là một mã VBA có thể giúp bạn nhập tất cả các tệp văn bản từ một thư mục cụ thể vào một trang tính mới.

1. Bật sổ làm việc bạn muốn nhập tệp văn bản và nhấn Alt + F11 phím để kích hoạt Microsoft Visual Basic cho các ứng dụng cửa sổ.

2. nhấp chuột Chèn > Mô-đun, sao chép và dán mã VBA bên dưới vào Mô-đun cửa sổ.

VBA: Nhập nhiều tệp văn bản từ một thư mục vào một trang tính

Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

3. nhấn F5 để hiển thị một hộp thoại và chọn một thư mục chứa các tệp văn bản bạn muốn nhập. Xem ảnh chụp màn hình:
doc nhập các tệp văn bản từ một thư mục 1

4. nhấp chuột OK. Sau đó, các tệp văn bản đã được nhập vào sổ làm việc hiện hoạt dưới dạng trang tính mới một cách riêng biệt.
doc nhập các tệp văn bản từ một thư mục 2


Nếu bạn muốn nhập một tệp văn bản vào một ô hoặc dải ô cụ thể, bạn có thể áp dụng Kutools cho Excel'S Chèn tệp tại con trỏ tiện ích.

Kutools cho Excel, với hơn 300 chức năng tiện dụng, giúp công việc của bạn dễ dàng hơn. 

Sau cài đặt miễn phí Kutools cho Excel, vui lòng làm như sau:

1. Chọn một ô bạn muốn nhập tệp văn bản và nhấp vào Kutools Plus > Nhập khẩu xuất khẩu > Chèn tệp tại con trỏ. Xem ảnh chụp màn hình:
doc nhập các tệp văn bản từ một thư mục 3

2. Sau đó, một hộp thoại bật ra, nhấp vào Xem để hiển thị Chọn một tập tin để được chèn vào hộp thoại vị trí con trỏ ô, hãy chọn tiếp theo Tệp văn bản từ danh sách thả xuống, sau đó chọn tệp văn bản bạn muốn nhập. Xem ảnh chụp màn hình:
doc nhập các tệp văn bản từ một thư mục 4

3. nhấp chuột Mở > Okvà tệp văn bản chỉ định đã được chèn vào vị trí con trỏ, xem ảnh chụp màn hình:
doc nhập các tệp văn bản từ một thư mục 5


Các công cụ năng suất văn phòng tốt nhất

Kutools cho Excel giải quyết hầu hết các vấn đề của bạn và tăng 80% năng suất của bạn

  • Tái sử dụng: Chèn nhanh công thức phức tạp, biểu đồ và bất cứ thứ gì bạn đã sử dụng trước đây; Mã hóa ô với mật khẩu; Tạo danh sách gửi thư và gửi email ...
  • Thanh siêu công thức (dễ dàng chỉnh sửa nhiều dòng văn bản và công thức); Bố cục đọc (dễ dàng đọc và chỉnh sửa số lượng ô lớn); Dán vào Dải ô đã Lọchữu ích. Cảm ơn !
  • Hợp nhất các ô / hàng / cột mà không làm mất dữ liệu; Nội dung phân chia ô; Kết hợp các hàng / cột trùng lặp... Ngăn chặn các ô trùng lặp; So sánh các dãyhữu ích. Cảm ơn !
  • Chọn trùng lặp hoặc duy nhất Hàng; Chọn hàng trống (tất cả các ô đều trống); Tìm siêu và Tìm mờ trong Nhiều Sổ làm việc; Chọn ngẫu nhiên ...
  • Bản sao chính xác Nhiều ô mà không thay đổi tham chiếu công thức; Tự động tạo tài liệu tham khảo sang Nhiều Trang tính; Chèn Bullets, Hộp kiểm và hơn thế nữa ...
  • Trích xuất văn bản, Thêm Văn bản, Xóa theo Vị trí, Xóa không gian; Tạo và In Tổng số phân trang; Chuyển đổi giữa nội dung ô và nhận xéthữu ích. Cảm ơn !
  • Siêu lọc (lưu và áp dụng các lược đồ lọc cho các trang tính khác); Sắp xếp nâng cao theo tháng / tuần / ngày, tần suất và hơn thế nữa; Bộ lọc đặc biệt bằng cách in đậm, in nghiêng ...
  • Kết hợp Workbook và WorkSheets; Hợp nhất các bảng dựa trên các cột chính; Chia dữ liệu thành nhiều trang tính; Chuyển đổi hàng loạt xls, xlsx và PDFhữu ích. Cảm ơn !
  • Hơn 300 tính năng mạnh mẽ. Hỗ trợ Office / Excel 2007-2021 và 365. Hỗ trợ tất cả các ngôn ngữ. Dễ dàng triển khai trong doanh nghiệp hoặc tổ chức của bạn. Đầy đủ tính năng Dùng thử miễn phí 30 ngày. Bảo đảm hoàn lại tiền trong 60 ngày.
tab kte 201905

Tab Office mang lại giao diện Tab cho Office và giúp công việc của bạn trở nên dễ dàng hơn nhiều

  • Cho phép chỉnh sửa và đọc theo thẻ trong Word, Excel, PowerPoint, Publisher, Access, Visio và Project.
  • Mở và tạo nhiều tài liệu trong các tab mới của cùng một cửa sổ, thay vì trong các cửa sổ mới.
  • Tăng 50% năng suất của bạn và giảm hàng trăm cú nhấp chuột cho bạn mỗi ngày!
officetab dưới cùng
Nhận xét (46)
Xếp hạng 4 trong 5 · xếp hạng 1
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Kiểm tra phụ ()
'Cập nhật bởiExtendoffice6 / 7 / 2016
Làm mờ xWb dưới dạng sổ làm việc
Làm mờ xToBook thành sổ làm việc
Làm mờ xStrPath dưới dạng chuỗi
Dim xFileDialog dưới dạng FileDialog
Dim xFile dưới dạng chuỗi
Dim xFiles as New Collection
Dim I As Long
Đặt xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Sai
xFileDialog.Title = "Chọn một thư mục [Kutools cho Excel]"
Nếu xFileDialog.Show = -1 Thì
xStrPath = xFileDialog.SelectedItems (1)
Cuối Nếu
If xStrPath = "" Then Exit Sub
If Right (xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir (xStrPath & "* .txt")
Nếu xFile = "" Thì
MsgBox "Không tìm thấy tệp", vbInformation, "Kutools cho Excel"
Thoát Sub
Cuối Nếu
Làm trong khi xFile <> ""
xFiles.Thêm xFile, xFile
xFile = Dir ()
Vòng lặp
Đặt xToBook = ThisWorkbook
Nếu xFiles.Count> 0 Thì
Đối với I = 1 Đến xFiles.Count
Đặt xWb = Workbooks.Open (xStrPath & xFiles.Item (I))
xWb.Worksheets (1). Sao chép sau: = xToBook.Sheets (xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xWb.Name
Về lỗi GoTo 0
xWb. Đóng Sai
Sau
Cuối Nếu
End Sub

mã này hữu ích nhưng tôi muốn

tab, dấu chấm phẩy, dấu cách true làm thế nào để làm điều này, vui lòng giúp tôi
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Bạn có muốn giữ khoảng trắng (dấu phân cách) sau khi chuyển đổi tệp văn bản thành trang tính không?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
đó cũng là vấn đề của tôi, mã này là đúng. nhưng sau khi chuyển đổi tệp văn bản sang excel, nó không giữ các dấu phân cách.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Bạn có thể tải lên tệp văn bản và kết quả bạn muốn cho tôi không?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Tôi có cùng một vấn đề. Các tệp txt đều nằm trong các trang tính riêng biệt và mã bỏ qua khoảng cách giữa hai cột
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Des và PB Rama Murty, đoạn mã dưới đây có thể chia dữ liệu thành các cột dựa trên không gian hoặc tab trong khi nhập tệp văn bản vào trang tính. Bạn có thể thử.

Sub ImportTextToExcel ()
'Cập nhật bởiExtendoffice20180911
Làm mờ xWb dưới dạng sổ làm việc
Làm mờ xToBook thành sổ làm việc
Làm mờ xStrPath dưới dạng chuỗi
Dim xFileDialog dưới dạng FileDialog
Dim xFile dưới dạng chuỗi
Dim xFiles as New Collection
Dim I As Long
Dim xIntRow càng lâu càng tốt
Dim xFNum, xFArr miễn là
Làm mờ xStrValue thành chuỗi
Dim xRg theo phạm vi
Làm mờ xArr
Đặt xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Sai
xFileDialog.Title = "Chọn một thư mục [Kutools cho Excel]"
Nếu xFileDialog.Show = -1 Thì
xStrPath = xFileDialog.SelectedItems (1)
Cuối Nếu
If xStrPath = "" Then Exit Sub
If Right (xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir (xStrPath & "* .txt")
Nếu xFile = "" Thì
MsgBox "Không tìm thấy tệp", vbInformation, "Kutools cho Excel"
Thoát Sub
Cuối Nếu
Làm trong khi xFile <> ""
xFiles.Thêm xFile, xFile
xFile = Dir ()
Vòng lặp
Đặt xToBook = ThisWorkbook
On Error Resume Next
Application.ScreenUpdating = Sai
Nếu xFiles.Count> 0 Thì

Đối với I = 1 Đến xFiles.Count
Đặt xWb = Workbooks.Open (xStrPath & xFiles.Item (I))
xWb.Worksheets (1). Sao chép sau: = xToBook.Sheets (xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb. Đóng Sai
xIntRow = ActiveCell.CienRegion.Rows.Count
Đối với xFNum = 1 Đến xIntRow
Đặt xRg = ActiveSheet.Range ("A" & xFNum)
xArr = Tách (xRg.Text, "")
Nếu UBound (xArr)> 0 Thì
Đối với xFArr = 0 Tới UBound (xArr)
Nếu xArr (xFArr) <> "" Thì
xRg.Value = xArr (xFArr)
Đặt xRg = xRg.Offset (ColumnOffset: = 1)
Cuối Nếu
Sau
Cuối Nếu
Sau
Sau
Cuối Nếu
Application.ScreenUpdating = True
End Sub
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Những thay đổi nào cần thiết nếu muốn chia dữ liệu thành các cột dựa trên dấu phẩy
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Những thay đổi nào cần được thực hiện nếu tôi cần tổng dữ liệu vào các cột dựa trên dấu phẩy?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Tôi đã sử dụng cái này và nó hoạt động nhưng tôi muốn lưu tất cả vào một trang tính vì mỗi trang tính đều có thông tin giống nhau, chúng chỉ là các tệp nhật ký mỗi ngày.
vì vậy tôi cần phải kết hợp các
tất cả các mục trong thư mục vào một trang tính
Sub ImportCSVsWithReference ()
'UpdatebyKutoolsforExcel20151214
Làm mờ xWb dưới dạng sổ làm việc
Làm mờ xToBook thành sổ làm việc
Làm mờ xStrPath dưới dạng chuỗi
Dim xFileDialog dưới dạng FileDialog
Dim xFile dưới dạng chuỗi
Dim xFiles as New Collection
Dim I As Long
Dim xIntRow càng lâu càng tốt
Dim xFNum, xFArr miễn là
Làm mờ xStrValue thành chuỗi
Dim xRg theo phạm vi
Làm mờ xArr
Lỗi GoTo ErrHandler
Đặt xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Sai
xFileDialog.Title = "Chọn một thư mục [Kutools cho Excel]"
Nếu xFileDialog.Show = -1 Thì
xStrPath = xFileDialog.SelectedItems (1)
Cuối Nếu
If xStrPath = "" Then Exit Sub
If Right (xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
Đặt xSht = ThisWorkbook.ActiveSheet
Nếu MsgBox ("Xóa trang tính hiện có trước khi nhập?", VbYesNo, "Kutools cho Excel") = vbYes Thì xSht.UsedRange.Clear
Application.ScreenUpdating = Sai
xFile = Dir(xStrPath & "\" & "*.log")
Làm trong khi xFile <> ""
Đặt xWb = Workbooks.Open (xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range ("A" & Rows.Count) .End (xlUp) .Offset (1)
xWb. Đóng Sai
xFile = Dir
Vòng lặp
Application.ScreenUpdating = True
Thoát Sub
Trình xử lý lỗi:
MsgBox "không có tệp txt", "Kutools cho Excel"
End Sub

và cái này sử dụng khoảng trắng cho từng cột

Sub ImportTextToExcel ()
'Cập nhật bởiExtendoffice20180911
Làm mờ xWb dưới dạng sổ làm việc
Làm mờ xToBook thành sổ làm việc
Làm mờ xStrPath dưới dạng chuỗi
Dim xFileDialog dưới dạng FileDialog
Dim xFile dưới dạng chuỗi
Dim xFiles as New Collection
Dim I As Long
Dim xIntRow càng lâu càng tốt
Dim xFNum, xFArr miễn là
Làm mờ xStrValue thành chuỗi
Dim xRg theo phạm vi
Làm mờ xArr
Đặt xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Sai
xFileDialog.Title = "Chọn một thư mục [Kutools cho Excel]"
Nếu xFileDialog.Show = -1 Thì
xStrPath = xFileDialog.SelectedItems (1)
Cuối Nếu
If xStrPath = "" Then Exit Sub
If Right (xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir (xStrPath & "* .txt")
Nếu xFile = "" Thì
MsgBox "Không tìm thấy tệp", vbInformation, "Kutools cho Excel"
Thoát Sub
Cuối Nếu
Làm trong khi xFile <> ""
xFiles.Thêm xFile, xFile
xFile = Dir ()
Vòng lặp
Đặt xToBook = ThisWorkbook
On Error Resume Next
Application.ScreenUpdating = Sai
Nếu xFiles.Count> 0 Thì

Đối với I = 1 Đến xFiles.Count
Đặt xWb = Workbooks.Open (xStrPath & xFiles.Item (I))
xWb.Worksheets (1). Sao chép sau: = xToBook.Sheets (xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb. Đóng Sai
xIntRow = ActiveCell.CienRegion.Rows.Count
Đối với xFNum = 1 Đến xIntRow
Đặt xRg = ActiveSheet.Range ("A" & xFNum)
xArr = Tách (xRg.Text, "")
Nếu UBound (xArr)> 0 Thì
Đối với xFArr = 0 Tới UBound (xArr)
Nếu xArr (xFArr) <> "" Thì
xRg.Value = xArr (xFArr)
Đặt xRg = xRg.Offset (ColumnOffset: = 1)
Cuối Nếu
Sau
Cuối Nếu
Sau
Sau
Cuối Nếu
Application.ScreenUpdating = True
End Sub
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
làm thế nào để làm nếu tệp Txt của tôi chứa được phân tách bằng dấu phẩy?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Bạn có thể sử dụng Tìm và Thay thế fuctuon để thay thế dấu phẩy bằng dấu cách trước tiên và áp dụng một trong các phương pháp trên để chuyển đổi nó sang tệp Excel.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Không có cách nào để thay đổi điều này trong mã? Tôi phải làm điều này với 130 tệp
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Câu hỏi tương tự
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Đối với những người vẫn cần trợ giúp về việc này, hãy thay thế xArr = Split (xRg.Text, "") bằng xArr = Split (xRg.Text, ",").
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Khi tôi chạy mô-đun như đã cho, nó sẽ thêm mỗi tệp .txt dưới dạng một trang tính mới, không phải dưới dạng một dòng mới vào trang tính hiện có. Có cách nào để đạt được điều đó dưới dạng đầu ra thay vì trang tính mới cho mỗi tệp .txt không?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Ý của bạn là kết hợp tất cả các tệp văn bản thành một trang tính?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Vâng, đây là những gì tôi muốn.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Davinder, bạn có thể thử mã vba bên dưới.
Sub ImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
    Dim xSht  As Worksheet
    Dim xWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Set xSht = ThisWorkbook.ActiveSheet
    If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
    Application.ScreenUpdating = False
    xFile = Dir(xStrPath & "\" & "*.txt")
    Do While xFile <> ""
        Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
        ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
        xWb.Close False
        xFile = Dir
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "no txt files", , "Kutools for Excel"
End Sub
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Mã này rất hữu ích, nó là mã duy nhất mà tôi tìm thấy để tải các tệp txt với số lượng lớn, bản sửa lỗi mà tôi cần trên nó cũng là những gì Joyce và Davinder đang theo đuổi.
Nó là giải nén các tệp .txt và dán tất cả chúng dưới nhau trong một cột cụ thể, giả sử cột 'N'.

Ngoài ra, cần biết liệu có thể thêm "điều kiện nếu" cho các tệp .txt được nhập như sau hay không.
nếu tệp .txt bắt đầu bằng chữ cái 'A' thì sẽ được dán trên 'tờ 1' bắt đầu bằng ô 'N2'
và nếu các tệp .txt bắt đầu bằng chữ cái 'B' thì dán trên 'Trang tính 2' bắt đầu bằng ô 'N2'
khác MsgBox là "Mục đích tệp .txt không được công nhận".

cảm ơn bạn trước
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Tôi có mã này làm việc cho tôi nhưng vẫn còn, tôi cần thay đổi một số trong đó.

* Tôi muốn nó dán trên cùng một trang tính mà không cần mở trang tính mới, sau đó sao chép vì nó mất nhiều thời gian hơn.

* cần phải chèn một điều kiện nếu để các tệp txt đã nhập được dán trên trang tính 1 nếu nó bắt đầu bằng chữ A và được nhập vào Trang tính 2 nếu nó bắt đầu bằng chữ B


Nội soi phụ3 ()
Làm mờ xWb dưới dạng sổ làm việc
Làm mờ xToBook thành sổ làm việc
Làm mờ xStrPath dưới dạng chuỗi
Dim xFileDialog dưới dạng FileDialog
Dim xFile dưới dạng chuỗi
Dim xFiles as New Collection
Dim i As Long
Dim LastRow As Long
Dim Rng Như Phạm vi
Đặt xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Sai
xFileDialog.Title = "Chọn một thư mục [Kutools cho Excel]"
Nếu xFileDialog.Show = -1 Thì
xStrPath = xFileDialog.SelectedItems (1)
Cuối Nếu
If xStrPath = "" Then Exit Sub
If Right (xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir (xStrPath & "* .txt")
Nếu xFile = "" Thì
MsgBox "Không tìm thấy tệp", vbInformation, "Kutools cho Excel"
Thoát Sub
Cuối Nếu
Làm trong khi xFile <> ""
xFiles.Thêm xFile, xFile
xFile = Dir ()
Vòng lặp
Phạm vi ("N2"). Chọn
Đặt xToBook = ThisWorkbook
Nếu xFiles.Count> 0 Thì
Đối với i = 1 Đến xFiles.Count
Đặt xWb = Workbooks.Open (xStrPath & xFiles.Item (i))
xWb.Kích hoạt
'Lựa chọn và sao chép dữ liệu txt
Phạm vi (Lựa chọn, Lựa chọn.End (xlDown)). Chọn
Lựa chọn. Sao chép
xToBook.Kích hoạt
ActiveSheet.Paste
Selection.End (xlDown) .Offset (1) .Select
On Error Resume Next
Về lỗi GoTo 0
xWb. Đóng Sai
Sau
Cuối Nếu
End Sub
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin lỗi, tay tôi bị trói
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, mã của tôi chạy nhưng chỉ nhập tệp đầu tiên. Nó nói rằng có một lỗi phương pháp để sao chép. Trình gỡ lỗi đánh dấu dòng mã sau. Có ý kiến ​​gì không?


xWb.Worksheets (1). Sao chép sau: = xToBook.Sheets (xToBook.Sheets.Count)
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Tôi có cùng một vấn đề, bất kỳ giải pháp tìm thấy?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Này katie,
Tôi biết rằng nhận xét của bạn khá cũ, nhưng tôi đã gặp phải vấn đề tương tự và đã khắc phục nó theo cách này: Mô-đun phải được chèn vào một thư mục con của dự án .xlsx đang hoạt động. Tôi đã mắc lỗi khi sao chép mã vào thư mục con của PERSONAL.XLSB, nơi tôi thường lưu trữ các macro của mình và nó thực hiện với các macro khác của tôi, nhưng không phải với macro này.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Làm thế nào bạn sẽ xóa các trang tính trong mã vba nếu bạn không muốn các bản sao khi thực thi lại mô-đun?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin lỗi, Harsh, hãy cẩn thận để tránh nhập lặp lại.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
xin chào, tôi muốn ngăn chặn việc xóa các số XNUMX đứng trước trong excel.

tôi đã thử mã bên dưới nhưng nó không hoạt động


Kiểm tra phụ ()
Làm mờ xWb dưới dạng sổ làm việc
Làm mờ xToBook thành sổ làm việc
Làm mờ xStrPath dưới dạng chuỗi
Dim xFileDialog dưới dạng FileDialog
Dim xFile dưới dạng chuỗi
Dim xFiles as New Collection
Dim I As Long
Mờ j Như Lâu
Đặt xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Sai
xFileDialog.Title = "Chọn một thư mục"
Nếu xFileDialog.Show = -1 Thì
xStrPath = xFileDialog.SelectedItems (1)
Cuối Nếu
If xStrPath = "" Then Exit Sub
If Right (xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir (xStrPath & "* .txt")
Nếu xFile = "" Thì
MsgBox "Không tìm thấy tệp", vbInformation, "Kutools cho Excel"
Thoát Sub
Cuối Nếu
Làm trong khi xFile <> ""
xFiles.Thêm xFile, xFile
xFile = Dir ()
Vòng lặp
Đặt xToBook = ThisWorkbook
Nếu xFiles.Count> 0 Thì
Đối với I = 1 Đến xFiles.Count
Đặt xWb = Workbooks.Open (xStrPath & xFiles.Item (I))
ActiveSheet.Cells.NumberFormat = "@" 'Đây là để tạo excel ở định dạng văn bản trước khi dán dữ liệu tệp văn bản
xWb.Worksheets (1) .Copy After: = xToBook.Sheets (xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xWb.Name
Về lỗi GoTo 0
xWb. Đóng Sai
Sau
Cuối Nếu
End Sub
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Pooja, bạn có thể thử chức năng Xóa Zeros hàng đầu của Kutools cho Excel để xóa tất cả các số không đứng đầu khỏi lựa chọn sau khi nhập.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
nhưng tôi không muốn gỡ bỏ. Tôi muốn ngăn chặn việc xóa các số XNUMX đứng trước.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Nếu bạn muốn giữ lại các số không ở đầu, bạn có thể định dạng chúng dưới dạng định dạng văn bản bằng Định dạng Ô.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, bạn sửa mã này như thế nào để chèn các tệp * .txt theo thứ tự: 1,2,3,4,5,6,7,8,9,10,11, v.v. Hiện tại mã chèn tệp như sau: 1,10,11,12,13,14,15,16,17,18,19,2,20,21, XNUMX, vv Cảm ơn!
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
có cơ hội nào để lấy tên trang tính chỉ một phần nhất định từ tên tệp txt không?

theo mã trên toàn bộ tên trang tính đã được sử dụng.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
cảm ơn rất nhiều công việc trên excel office 2007
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, mã của tôi chạy nhưng chỉ nhập tệp đầu tiên. Nó nói rằng có một lỗi phương pháp để sao chép. Trình gỡ lỗi đánh dấu dòng mã sau. Có ý kiến ​​gì không?


xWb.Worksheets (1). Sao chép sau: = xToBook.Sheets (xToBook.Sheets.Count)
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Này Martinho,
Tôi đã gặp vấn đề tương tự và đã giải quyết nó bằng cách thay đổi dòng này:
Đặt xToBook = ThisWorkbook
đến
Đặt xToBook = ActiveWorkbook
Có lẽ điều này sẽ hữu ích.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
0

tôi cần bạn giúp, tôi không biết vba excel tôi muốn nhập nhiều tệp văn bản như 13000. Tên tệp văn bản giống với ô chẳng hạn (c1 = 112 nên tên tệp văn bản cũng là 112) nghĩa là tệp văn bản 112 là nhập c112.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
tôi cần bạn giúp, tôi không biết vba excel tôi muốn nhập nhiều tệp văn bản như 13000. Tên tệp văn bản giống với ô chẳng hạn (c1 = 112 nên tên tệp văn bản cũng là 112) nghĩa là tệp văn bản 112 là nhập c112.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Mã hoạt động nhưng nhập từng tệp văn bản vào tab mới trong sổ làm việc. Bất kỳ ý tưởng nào trong mã này có thể được thay đổi để nhập tệp văn bản mới trên cùng một trang tính bên dưới dữ liệu từ tệp văn bản cuối cùng?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Trong đoạn mã dưới đây, nếu tôi muốn chỉ định thư mục thay vì chọn đường dẫn mỗi khi nhập tệp văn bản, thì sửa đổi phải làm gì

MÃ VBA:

Sub ImportCSVsWithReference ()
'UpdatebyKutoolsforExcel20151214
Dim xSht As Worksheet
Làm mờ xWb dưới dạng sổ làm việc
Làm mờ xStrPath dưới dạng chuỗi
Dim xFileDialog dưới dạng FileDialog
Dim xFile dưới dạng chuỗi
Lỗi GoTo ErrHandler
Đặt xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Sai
xFileDialog.Title = "Chọn một thư mục [Kutools cho Excel]"
Nếu xFileDialog.Show = -1 Thì
xStrPath = xFileDialog.SelectedItems (1)
Cuối Nếu
If xStrPath = "" Then Exit Sub
Đặt xSht = ThisWorkbook.ActiveSheet
Nếu MsgBox ("Xóa trang tính hiện có trước khi nhập?", VbYesNo, "Kutools cho Excel") = vbYes Thì xSht.UsedRange.Clear
Application.ScreenUpdating = Sai
xFile = Dir (xStrPath & "\" & "* .txt")
Làm trong khi xFile <> ""
Đặt xWb = Workbooks.Open (xStrPath & "\" & xFile)
ActiveSheet.UsedRange.Copy xSht.Range ("A" & Rows.Count) .End (xlUp) .Offset (1)
xWb. Đóng Sai
xFile = Dir
Vòng lặp
Application.ScreenUpdating = True
Thoát Sub
Trình xử lý lỗi:
MsgBox "không có tệp txt", "Kutools cho Excel"
End Sub
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, vui lòng thử mã bên dưới
Sub Test()
'UpdatebyExtendoffice6/7/2016
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    xStrPath = "C:\Users\AddinsVM001\Desktop\test" 'Here is the parth you can modify
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            On Error GoTo 0
            xWb.Close False
        Next
    End If
End Sub

"C: \ Users \ AddinsVM001 \ Desktop \ test" là đường dẫn thư mục bạn có thể nhập tệp văn bản từ đó, vui lòng thay đổi nó khi bạn cần.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, cảm ơn vì mã VBA quý giá của bạn.
Tuy nhiên, tôi cần mã cho nhiều tệp txt thành 'một trang tính trong trang tính, không phải một trang tính riêng lẻ cho mỗi tệp txt'.
Tôi nên chỉnh sửa mã của bạn cho mục đích của tôi là gì?

Cảm ơn,
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, vui lòng thử mã bên dưới
Sub Test()
    'UpdatebyExtendoffice 10/26/2022
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
    Dim J As Long
    Dim xRg As Range
    Dim xSaveRg As Range
    Dim xSh As Worksheet
    
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found", vbInformation, "Kutools for Excel"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    Set xSh = xToBook.Sheets.Add
    Set xRg = xSh.Range("A1")
    J = 1
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
            Set xSaveRg = xWb.Worksheets(1).UsedRange
            J = xSaveRg.Rows.Count + 1 + J
            Debug.Print xRg.Address
            xSaveRg.Copy Destination:=xRg
            On Error Resume Next
            xWb.Close False
            
            Set xRg = xSh.Cells(J, 1)
        Next
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Điều này hoạt động tốt. Nhưng khi import nó lại đổi tên sheet bằng name.txt làm sao để nó chỉ giữ lại tên mà không thêm đuôi .txt vào sheet?
Xếp hạng 3.5 trong 5
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Ok nvm đã tìm thấy câu trả lời với sự trợ giúp của google.
thay thế dòng:
ActiveSheet.Name = xWb.Name
với:
ActiveSheet.Name = Left(xWb.Name,Len(xWb.Name)-4)
sẽ xóa 4 chữ cái cuối cùng khỏi tên trang tính. Hiệu quả cho tôi những gì tôi cần. tên không có .txt
Xếp hạng 4 trong 5
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
đoạn mã dưới đây có thể chia dữ liệu thành các cột dựa trên khoảng trắng hoặc tab trong khi nhập tệp văn bản vào trang tính. Nhưng tôi không muốn có một tab riêng cho từng tệp txt mà tôi muốn tất cả chúng dưới một trang tính. Thông tin có cùng định dạng cho mỗi tệp. . Những gì có thể được sửa đổi để cho phép đây là tất cả một trang tính thay vì mỗi tệp được nhập là một tab mới bất kỳ và tất cả trợ giúp sẽ được đánh giá cao

Sub ImportTextToExcel ()
'Cập nhật bởiExtendoffice20180911
Làm mờ xWb dưới dạng sổ làm việc
Làm mờ xToBook thành sổ làm việc
Làm mờ xStrPath dưới dạng chuỗi
Dim xFileDialog dưới dạng FileDialog
Dim xFile dưới dạng chuỗi
Dim xFiles as New Collection
Dim I As Long
Dim xIntRow càng lâu càng tốt
Dim xFNum, xFArr miễn là
Làm mờ xStrValue thành chuỗi
Dim xRg theo phạm vi
Làm mờ xArr
Đặt xFileDialog = Application.FileDialog (msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = Sai
xFileDialog.Title = "Chọn một thư mục [Kutools cho Excel]"
Nếu xFileDialog.Show = -1 Thì
xStrPath = xFileDialog.SelectedItems (1)
Cuối Nếu
If xStrPath = "" Then Exit Sub
If Right (xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir (xStrPath & "* .txt")
Nếu xFile = "" Thì
MsgBox "Không tìm thấy tệp", vbInformation, "Kutools cho Excel"
Thoát Sub
Cuối Nếu
Làm trong khi xFile <> ""
xFiles.Thêm xFile, xFile
xFile = Dir ()
Vòng lặp
Đặt xToBook = ThisWorkbook
On Error Resume Next
Application.ScreenUpdating = Sai
Nếu xFiles.Count> 0 Thì

Đối với I = 1 Đến xFiles.Count
Đặt xWb = Workbooks.Open (xStrPath & xFiles.Item (I))
xWb.Worksheets (1). Sao chép sau: = xToBook.Sheets (xToBook.Sheets.Count)

ActiveSheet.Name = xWb.Name

xWb. Đóng Sai
xIntRow = ActiveCell.CienRegion.Rows.Count
Đối với xFNum = 1 Đến xIntRow
Đặt xRg = ActiveSheet.Range ("A" & xFNum)
xArr = Tách (xRg.Text, "")
Nếu UBound (xArr)> 0 Thì
Đối với xFArr = 0 Tới UBound (xArr)
Nếu xArr (xFArr) <> "" Thì
xRg.Value = xArr (xFArr)
Đặt xRg = xRg.Offset (ColumnOffset: = 1)
Cuối Nếu
Sau
Cuối Nếu
Sau
Sau
Cuối Nếu
Application.ScreenUpdating = True
End Sub
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Daniel, hãy thử mã bên dưới, nó nhập tất cả các tệp văn bản trong một trang tính có tên Txt.
Lưu ý rằng: nếu tên văn bản giống với tên trang tính đã tồn tại, tệp văn bản có thể không được nhập.
Sub ImportTextToExcel2()

'UpdatebyExtendoffice20230106

Dim xWb As Workbook

Dim xToBook As Workbook

Dim xStrPath As String

Dim xFileDialog As FileDialog

Dim xFile As String

Dim xFiles As New Collection

Dim I As Long

Dim xIntRow As Long

Dim xFNum, xFArr As Long

Dim xStrValue As String

Dim xRg As Range

Dim xArr

Dim xRowL, xRowH As Integer

Dim xTxtWS, xWSD As Worksheet

Dim xTxtWS_Rg As Range

Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)

xFileDialog.AllowMultiSelect = False

xFileDialog.Title = "Select a folder [Kutools for Excel]"

If xFileDialog.Show = -1 Then

xStrPath = xFileDialog.SelectedItems(1)

End If

If xStrPath = "" Then Exit Sub

If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"

xFile = Dir(xStrPath & "*.txt")

If xFile = "" Then

MsgBox "No files found", vbInformation, "Kutools for Excel"

Exit Sub

End If

Do While xFile <> ""

xFiles.Add xFile, xFile

xFile = Dir()

Loop

Set xToBook = ThisWorkbook

On Error Resume Next

Set xTxtWS = xToBook.Worksheets("Txt")

If IsNull(xTxtWS) Or IsEmpty(xTxtWS) Then

    Set xTxtWS = xToBook.Worksheets.Add

    xTxtWS.Name = "Txt"

End If

Application.ScreenUpdating = False

Application.DisplayAlerts = False

xTxtWS.Activate

If xFiles.Count > 0 Then

xRowL = 1

For I = 1 To xFiles.Count

Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))

xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)

Set xWSD = xToBook.Sheets(xToBook.Sheets.Count)

xTxtWS.Activate

xWb.Close False

xIntRow = xWSD.UsedRange.CurrentRegion.Rows.Count

    For xFNum = 1 To xIntRow

        Set xRg = xWSD.Range("A" & xFNum)

        xArr = Split(xRg.Text, " ")

        Set xTxtWS_Rg = xTxtWS.Cells.Range("A" & xRowL)

'        If UBound(xArr) > 0 Then

            For xFArr = 0 To UBound(xArr)

                If xArr(xFArr) <> "" Then

                xTxtWS_Rg.Value = xArr(xFArr)

                Set xTxtWS_Rg = xTxtWS_Rg.Offset(ColumnOffset:=1)

                End If

            Next

'        End If

xRowL = xRowL + 1

    Next

xWSD.Delete

Next

End If

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub


Không có bình luận nào được đăng ở đây
Để lại ý kiến ​​của bạn
Đăng với tư cách khách
×
Đánh giá bài viết này:
0   Nhân vật
Các vị trí được đề xuất

Kết nối với chúng tôi

Bản quyền © 2009 - www.extendoffice.com. | Đã đăng ký Bản quyền. cung cấp bởi ExtendOffice. | BẢN ĐỒ CHI NHÁNH
Microsoft và logo Office là các nhãn hiệu hoặc nhãn hiệu đã đăng ký của Microsoft Corporation tại Hoa Kỳ và / hoặc các quốc gia khác.
Được bảo vệ bởi Sectigo SSL