Hướng dẫn copy từ notepad sang excel

Question

Bài 12. FileSystemObject (Danh sách các bài viết về VBA xem ở đây Index - Các bài viết về VBA) FileSystemObject (FSo) là một phần trong thư viện Microsoft Scripting Runtime (scrrun.dll), là công cụ xử lý về Drive, Folder, File. Nội dung chính gồm:

1 1. Khai báo 2. Các phương thức 2.1...

giaiphapexcel.com

1+1=2

Thành viên bị đình chỉ hoạt động

3

Tìm đọc bài của bạn @befaint

Bài 12. FileSystemObject (Danh sách các bài viết về VBA xem ở đây Index - Các bài viết về VBA) FileSystemObject (FSo) là một phần trong thư viện Microsoft Scripting Runtime (scrrun.dll), là công cụ xử lý về Drive, Folder, File. Nội dung chính gồm:

1 1. Khai báo 2. Các phương thức 2.1...

giaiphapexcel.com

cháu đang đọc. Mà Thật sự nó quá dài. Cháu chưa tìm được đoạn code đó. chưa thấy chổ nào có chổ Liên quan đến Ctrl A tất cả trong Notepad và dán vào excel . Mong bác giúp đở.

Đại khái đoạn code cháu mong muốn như thế này 1. Mở file notpad ( Tức nhiên đường dẫn cháu tự sữa ) 2. Ctrl + A và tiếp tục Ctrl + C để copy tất cả dử liệu trong Notepad 3. Đặt con trỏ vào 1 ô nào đó trên bảng tình và Ctrl + V để Dán dữ liệu vào Excel 4. Đóng file notepad

4

cháu đang đọc. Mà Thật sự nó quá dài. Cháu chưa tìm được đoạn code đó. chưa thấy chổ nào có chổ Liên quan đến Ctrl A tất cả trong Notepad và dán vào excel . Mong bác giúp đở.

Đại khái đoạn code cháy mong muốn như thế này 1. Mở file notpad ( Tức nhiên đường dẫn cháu tự sữa ) 2. Ctrl + A và tiếp tục Ctrl + C để copy tất cả dử liệu 3. Đặt con trỏ vào 1 ô nào đó trên bảng tình và Ctrl + V để Dán dữ liệu 4. Đóng file notepad

Không cần mở file text và Ctrl+A, chỉ cần đường dẫn

Mã:

'// Tra ve chuoi la noi dung cua text file theo duong dan chi dinh'
Public Function ReadTextFile(ByVal pathTextFile As String) As String
    Dim FSo As Object, txtFile As Object, sText As String
    Set FSo = CreateObject("Scripting.FileSystemObject")
    Set txtFile = FSo.OpenTextFile(pathTextFile, 1, False, -2)
    sText = txtFile.ReadAll
    txtFile.Close
    ReadTextFile = sText
End Function

1+1=2

Thành viên bị đình chỉ hoạt động

5

Không cần mở file text và Ctrl+A, chỉ cần đường dẫn

Mã:

'// Tra ve chuoi la noi dung cua text file theo duong dan chi dinh'
Public Function ReadTextFile(ByVal pathTextFile As String) As String
Dim FSo As Object, txtFile As Object, sText As String
Set FSo = CreateObject("Scripting.FileSystemObject")
Set txtFile = FSo.OpenTextFile(pathTextFile, 1, False, -2)
sText = txtFile.ReadAll
txtFile.Close
ReadTextFile = sText
End Function

Cháu cảm ơn bác. Nhưng cái đó là Hàm. Mong bác viết ra Sub giúp cháu. tại cháu đang học VBA khóa cơ bản nưa chưa rành các thủ tục viết code. 1 Lần nữa rất mong chú giúp đỡ

6

Cháu cảm ơn bác. Nhưng cái đó là Hàm. Mong bác viết ra Sub giúp cháu. tại cháu đang học VBA khóa cơ bản nưa chưa rành các thủ tục viết code. 1 Lần nữa rất mong chú giúp đỡ

Bạn tham khảo thêm code trên GPE không nhớ của thành viên quản trị nào

Mã:

Đây là 1 code dùng để import dữ liệu từ 1 hay nhiều file txt vào file excel.
Với code này bạn chỉ cần kiểm tra xem file txt sử dụng dấu phân cách gì và sửa lại chỗ Delimiter= vbTab
Nếu dấu phân cách là dấu phẩy (,) thì sửa lại thế này Delimiter= ","
Lưu ý là code này khai báo chỉ số lớn nhất của mảng chỉ có 65536, nếu dữ liệu có nhiều hơn thì sẽ gây ra lỗi. Trong trường hợp đó bạn có thể sửa số 65536 thành 1 số lớn hơn. (Chắc hiếm gặp)
Code này sẽ xử lý tất cả file text xong rồi mới gán dữ liệu 1 lần xuống sheet tại ô A2. Bạn có thể sửa lại cho phù hợp.
PHP Code:
Sub ImportTextToExcel()
Dim fso As Object, FilesToOpen, TextSource As Object, TotalLines, Res()
Dim ItemsOfLine, TextItem, Delimiter As String, n As Byte
Dim K As Long, X As Byte, Cols As Integer, LineNum As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Delimiter = vbTab
FilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
If Not IsArray(FilesToOpen) Then Exit Sub
For X = LBound(FilesToOpen) To UBound(FilesToOpen)
   Set TextSource = fso.OpenTextFile(FilesToOpen(X), 1, , -2)
   TotalLines = Split(TextSource.ReadAll, vbCrLf)
   For LineNum = LBound(TotalLines) To UBound(TotalLines)
      ItemsOfLine = TotalLines(LineNum)
      TextItem = Split(ItemsOfLine, Delimiter)
      If UBound(TextItem) + 1 > n Then
          ReDim Preserve Res(1 To 65536, 1 To UBound(TextItem) + 1)
          n = UBound(TextItem) + 1
      End If
      If ItemsOfLine <> String(Len(ItemsOfLine), vbTab) Then
         K = K + 1
         For Cols = LBound(TextItem) To UBound(TextItem)
            Res(K, Cols + 1) = TextItem(Cols)
         Next
      End If
   Next
Next
[A2].Resize(K, UBound(Res, 2)) = Res
End Sub

1+1=2

Thành viên bị đình chỉ hoạt động

7

Bạn tham khảo thêm code trên GPE không nhớ của thành viên quản trị nào

Mã:


Đây là 1 code dùng để import dữ liệu từ 1 hay nhiều file txt vào file excel.
Với code này bạn chỉ cần kiểm tra xem file txt sử dụng dấu phân cách gì và sửa lại chỗ Delimiter= vbTab
Nếu dấu phân cách là dấu phẩy (,) thì sửa lại thế này Delimiter= ","
Lưu ý là code này khai báo chỉ số lớn nhất của mảng chỉ có 65536, nếu dữ liệu có nhiều hơn thì sẽ gây ra lỗi. Trong trường hợp đó bạn có thể sửa số 65536 thành 1 số lớn hơn. (Chắc hiếm gặp)
Code này sẽ xử lý tất cả file text xong rồi mới gán dữ liệu 1 lần xuống sheet tại ô A2. Bạn có thể sửa lại cho phù hợp.
PHP Code:
Sub ImportTextToExcel()
Dim fso As Object, FilesToOpen, TextSource As Object, TotalLines, Res()
Dim ItemsOfLine, TextItem, Delimiter As String, n As Byte
Dim K As Long, X As Byte, Cols As Integer, LineNum As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Delimiter = vbTab
FilesToOpen = Application.GetOpenFilename("Text Files (.txt), .txt", , , , True)If Not IsArray(FilesToOpen) Then Exit Sub
For X = LBound(FilesToOpen) To UBound(FilesToOpen)
Set TextSource = fso.OpenTextFile(FilesToOpen(X), 1, , -2)
TotalLines = Split(TextSource.ReadAll, vbCrLf)
For LineNum = LBound(TotalLines) To UBound(TotalLines)
ItemsOfLine = TotalLines(LineNum)
TextItem = Split(ItemsOfLine, Delimiter)
If UBound(TextItem) + 1 > n Then
ReDim Preserve Res(1 To 65536, 1 To UBound(TextItem) + 1)
n = UBound(TextItem) + 1
End If
If ItemsOfLine <> String(Len(ItemsOfLine), vbTab) Then
K = K + 1
For Cols = LBound(TextItem) To UBound(TextItem)
Res(K, Cols + 1) = TextItem(Cols)
Next
End If
Next
Next
[A2].Resize(K, UBound(Res, 2)) = Res
End Sub

Code chạy ok rồi cảm ơn CHú nhiều. Trường hợp cháu chỉ lấy mỗi 1 file notepad tại đưởng dẩn đã cài đặt sẳng Sheets("data").Range("M2") thì sữa lại đoạn này FilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)

Như thế nào để nó hiểu nó lấy từ Sheets("data").Range("M2")

Cu Tồ

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

8

Bạn tham khảo thêm code trên GPE không nhớ của thành viên quản trị nào

Mã:


Đây là 1 code dùng để import dữ liệu từ 1 hay nhiều file txt vào file excel.
Với code này bạn chỉ cần kiểm tra xem file txt sử dụng dấu phân cách gì và sửa lại chỗ Delimiter= vbTab
Nếu dấu phân cách là dấu phẩy (,) thì sửa lại thế này Delimiter= ","
Lưu ý là code này khai báo chỉ số lớn nhất của mảng chỉ có 65536, nếu dữ liệu có nhiều hơn thì sẽ gây ra lỗi. Trong trường hợp đó bạn có thể sửa số 65536 thành 1 số lớn hơn. (Chắc hiếm gặp)
Code này sẽ xử lý tất cả file text xong rồi mới gán dữ liệu 1 lần xuống sheet tại ô A2. Bạn có thể sửa lại cho phù hợp.
PHP Code:
Sub ImportTextToExcel()
Dim fso As Object, FilesToOpen, TextSource As Object, TotalLines, Res()
Dim ItemsOfLine, TextItem, Delimiter As String, n As Byte
Dim K As Long, X As Byte, Cols As Integer, LineNum As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Delimiter = vbTab
FilesToOpen = Application.GetOpenFilename("Text Files (.txt), .txt", , , , True)If Not IsArray(FilesToOpen) Then Exit Sub
For X = LBound(FilesToOpen) To UBound(FilesToOpen)
Set TextSource = fso.OpenTextFile(FilesToOpen(X), 1, , -2)
TotalLines = Split(TextSource.ReadAll, vbCrLf)
For LineNum = LBound(TotalLines) To UBound(TotalLines)
ItemsOfLine = TotalLines(LineNum)
TextItem = Split(ItemsOfLine, Delimiter)
If UBound(TextItem) + 1 > n Then
ReDim Preserve Res(1 To 65536, 1 To UBound(TextItem) + 1)
n = UBound(TextItem) + 1
End If
If ItemsOfLine <> String(Len(ItemsOfLine), vbTab) Then
K = K + 1
For Cols = LBound(TextItem) To UBound(TextItem)
Res(K, Cols + 1) = TextItem(Cols)
Next
End If
Next
Next
[A2].Resize(K, UBound(Res, 2)) = Res
End Sub

Bác cho hỏi code lỗi phần thông dịch thì sửa lại như thế nào à? khi file txt có tiếng nhật hàn hoặc tiếng trung thì dữ liệu đưa vào bảng tính bị thay đổi ạ

9

Code chạy ok rồi cảm ơn CHú nhiều. Trường hợp cháu chỉ lấy mỗi 1 file notepad tại đưởng dẩn đã cài đặt sẳng Sheets("data").Range("M2") thì sữa lại đoạn này FilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)

Như thế nào để nó hiểu nó lấy từ Sheets("data").Range("M2")

Lấy lệnh 2 code ghép lại

Mã:

Sub ImportTextToExcel()
Dim fso As Object, FilesToOpen, TextSource As Object, TotalLines, Res()
Dim ItemsOfLine, TextItem, Delimiter As String, n As Byte
Dim K As Long, X As Byte, Cols As Integer, LineNum As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Delimiter = vbTab   
    pathTextFile=Sheets("data").Range("M2").value
   Set TextSource = fso.OpenTextFile(pathTextFile, 1, , -2)
   TotalLines = Split(TextSource.ReadAll, vbCrLf)
   For LineNum = LBound(TotalLines) To UBound(TotalLines)
      ItemsOfLine = TotalLines(LineNum)
      TextItem = Split(ItemsOfLine, Delimiter)
      If UBound(TextItem) + 1 > n Then
          ReDim Preserve Res(1 To 65536, 1 To UBound(TextItem) + 1)
          n = UBound(TextItem) + 1
      End If
      If ItemsOfLine <> String(Len(ItemsOfLine), vbTab) Then
         K = K + 1
         For Cols = LBound(TextItem) To UBound(TextItem)
            Res(K, Cols + 1) = TextItem(Cols)
         Next
      End If
   Next
[A2].Resize(K, UBound(Res, 2)) = Res
End Sub

Bài đã được tự động gộp: 13/7/20

Bác cho hỏi code lỗi phần thông dịch thì sửa lại như thế nào à? khi file txt có tiếng nhật hàn hoặc tiếng trung thì dữ liệu đưa vào bảng tính bị thay đổi ạ

Có file ví dụ mới biết xử lý như thế nào

1+1=2

Thành viên bị đình chỉ hoạt động

10

Lấy lệnh 2 code ghép lại

Mã:

Sub ImportTextToExcel()
Dim fso As Object, FilesToOpen, TextSource As Object, TotalLines, Res()
Dim ItemsOfLine, TextItem, Delimiter As String, n As Byte
Dim K As Long, X As Byte, Cols As Integer, LineNum As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Delimiter = vbTab
pathTextFile=Sheets("data").Range("M2").value
Set TextSource = fso.OpenTextFile(pathTextFile, 1, , -2)
TotalLines = Split(TextSource.ReadAll, vbCrLf)
For LineNum = LBound(TotalLines) To UBound(TotalLines)
ItemsOfLine = TotalLines(LineNum)
TextItem = Split(ItemsOfLine, Delimiter)
If UBound(TextItem) + 1 > n Then
ReDim Preserve Res(1 To 65536, 1 To UBound(TextItem) + 1)
n = UBound(TextItem) + 1
End If
If ItemsOfLine <> String(Len(ItemsOfLine), vbTab) Then
K = K + 1
For Cols = LBound(TextItem) To UBound(TextItem)
Res(K, Cols + 1) = TextItem(Cols)
Next
End If
Next
[A2].Resize(K, UBound(Res, 2)) = Res
End Sub

Bài đã được tự động gộp: 13/7/20

Có file ví dụ mới biết xử lý như thế nào

Chân thành cảm ơn chú nhiều

Cu Tồ

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

11

file đây bác ah,khi e thử với tiếng nước ngoài thì nội dung đưa vào và nội dung notpad không giống nhau ạ

test.rar 15.6 KB · Đọc: 6
12

Chân thành cảm ơn chú nhiều

Bạn nên tham khảo cách dùng FileSystemObject chuyển dữ liệu Excel vào file Text

Cu Tồ

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

14

file đây bác ah,khi e thử với tiếng nước ngoài thì nội dung đưa vào và nội dung notpad không giống nhau ạ

Bạn chọn 2 ô format theo font chữ nước Nhật hoặc Hàn xem sao

Cu Tồ

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

15

file đây bác ah,khi e thử với tiếng nước ngoài thì nội dung đưa vào và nội dung notpad không giống nhau ạ

còn đây là e thử code lúc nãy bác vừa đưa lên cũng bị như thế ạ

Bài đã được tự động gộp: 13/7/20

Bạn chọn 2 ô format theo font chữ nước Nhật hoặc Hàn xem sao

e đã thử nhưng vẫn lỗi như thế bác ạ

Cu Tồ

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

17

Do code viết chưa xét được chữ nước ngoài

có cách khắc phục không bác ơi?

18

file đây bác ah,khi e thử với tiếng nước ngoài thì nội dung đưa vào và nội dung notpad không giống nhau ạ

Ngay cả tiếng Việt thì cũng thế thôi, đâu cần đi xa kiểm tra Nhật Hàn. Dễ kiểm tra thôi.

Bạn làm thí nghiệm nhé.

1. Hãy kích hoạt Unikey, chọn Bảng mã là Unicode -> mở notepad -> gõ sung sướng -> ghi lại với encoding = UTF-8 -> chạy code -> chọn tập tin vừa lưu. Sẽ thấy đầu trâu mặt ngựa.

2. Hãy kích hoạt Unikey, chọn Bảng mã là Unicode -> mở notepad -> gõ sung sướng -> ghi lại với encoding = Unicode, vd. trong Windows 10 chọn UTF-16 LE (Unicode Little Endian) -> chạy code -> chọn tập tin vừa lưu. Sẽ thấy sung sướng.

Bạn hiểu rồi chứ?

Tập tin của bạn hiện có encoding = UTF-8. Hãy mở bằng notepad và lưu lại với encoding = UTF-16 LE. Sau đó chạy code và chọn tập tin. Về phông chữ để hiển thị thì bạn có thể chọn phông chữ Times New Roman.

Cu Tồ

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

19

Ngay cả tiếng Việt thì cũng thế thôi, đâu cần đi xa kiểm tra Nhật Hàn. Dễ kiểm tra thôi.

Bạn làm thí nghiệm nhé.

1. Hãy kích hoạt Unikey, chọn Bảng mã là Unicode -> mở notepad -> gõ sung sướng -> ghi lại với encoding = UTF-8 -> chạy code -> chọn tập tin vừa lưu. Sẽ thấy đầu trâu mặt ngựa.

2. Hãy kích hoạt Unikey, chọn Bảng mã là Unicode -> mở notepad -> gõ sung sướng -> ghi lại với encoding = Unicode, vd. trong Windows 10 chọn UTF-16 LE (Unicode Little Endian) -> chạy code -> chọn tập tin vừa lưu. Sẽ thấy sung sướng.

Bạn hiểu rồi chứ?

Tập tin của bạn hiện có encoding = UTF-8. Hãy mở bằng notepad và lưu lại với encoding = UTF-16 LE. Sau đó chạy code và chọn tập tin. Về phông chữ để hiển thị thì bạn có thể chọn phông chữ Times New Roman.

cảm ơn bác đã hướng dẫn,e làm theo cách của bác được rồi ạ

1+1=2

Thành viên bị đình chỉ hoạt động

20

Ngay cả tiếng Việt thì cũng thế thôi, đâu cần đi xa kiểm tra Nhật Hàn. Dễ kiểm tra thôi.

Bạn làm thí nghiệm nhé.

1. Hãy kích hoạt Unikey, chọn Bảng mã là Unicode -> mở notepad -> gõ sung sướng -> ghi lại với encoding = UTF-8 -> chạy code -> chọn tập tin vừa lưu. Sẽ thấy đầu trâu mặt ngựa.

2. Hãy kích hoạt Unikey, chọn Bảng mã là Unicode -> mở notepad -> gõ sung sướng -> ghi lại với encoding = Unicode, vd. trong Windows 10 chọn UTF-16 LE (Unicode Little Endian) -> chạy code -> chọn tập tin vừa lưu. Sẽ thấy sung sướng.

Bạn hiểu rồi chứ?

Tập tin của bạn hiện có encoding = UTF-8. Hãy mở bằng notepad và lưu lại với encoding = UTF-16 LE. Sau đó chạy code và chọn tập tin. Về phông chữ để hiển thị thì bạn có thể chọn phông chữ Times New Roman.

Cháu chân thành cảm ơn 2 Bác @batman1 @HieuCD đã hỗ trợ. sau khi cháu kiểm tra lại thì code nó không lấy chính xác trong Notepad ra Excel nó tự xóa bỏ đi các dòng trống. Ý của cháu kiểu như là như thế này cháu xin nói rõ như sau: Cháu đang dùng đoạn code này của Bác @ndu96081631 Code này dùng để copy 1 vùng dữ liệu trên Excel ra Notepad code chạy rất chính xác

Mã:

Sub xuatexcelnotepad()
   'On Error Resume Next
    Dim rngData As Range
    Dim strData As String
    Dim strTempFile As String
    ' Nguon copy
    Set rngData = Range("a1:c16")
    rngData.Copy
    ' mac dinh
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        strData = .GetText
    End With
    ' nguon notepad
    strTempFile = Range("E1").Value
    CreateObject("Scripting.FileSystemObject").CreateTextFile(strTempFile, True, True).Write strData
    Application.CutCopyMode = False
End Sub

Nhưng giờ sau cháu muốn lấy ngược lại nghĩa là lấy từ Notepad đổ vào lại trong Excel . Thì cháy dùng code của Bác HieuCD

Mã:

Sub ImportTextToExcel()
On Error Resume Next
Dim fso As Object, FilesToOpen, TextSource As Object, TotalLines, Res()
Dim ItemsOfLine, TextItem, Delimiter As String, n As Byte
Dim K As Long, X As Byte, Cols As Integer, LineNum As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Delimiter = vbTab
    pathTextFile = Range("e1").Value ' Duong dan Lay
   Set TextSource = fso.OpenTextFile(pathTextFile, 1, , -2)
   TotalLines = Split(TextSource.ReadAll, vbCrLf)
   For LineNum = LBound(TotalLines) To UBound(TotalLines)
      ItemsOfLine = TotalLines(LineNum)
      TextItem = Split(ItemsOfLine, Delimiter)
      If UBound(TextItem) + 1 > n Then
          ReDim Preserve Res(1 To 65536, 1 To UBound(TextItem) + 1)
          n = UBound(TextItem) + 1
      End If
      If ItemsOfLine <> String(Len(ItemsOfLine), vbTab) Then
         K = K + 1
         For Cols = LBound(TextItem) To UBound(TextItem)
            Res(K, Cols + 1) = TextItem(Cols)
         Next
      End If
   Next
[f1].Resize(K, UBound(Res, 2)) = Res ' Output
End Sub

Mà không hiểu sao nó lại xóa đi mầy dòng trống. Cháu muốn nó kiểu như làm thủ công là Ctrl +A toàn bộ file Notepad sau đó Ctrl + C, rồi chọn vào Excel rồi Ctrl + V thế là xong. rất mong các chú giúp cháu. cháu xin chân thành cảm ơn các chú

hướng dẫn Mẹo Hay DAT to txt

Hướng dẫn copy từ notepad sang excel

1 1. Khai báo 2. Các phương thức 2.1...

1+1=2

Thành viên bị đình chỉ hoạt động

3

1 1. Khai báo 2. Các phương thức 2.1...

4

1+1=2

Thành viên bị đình chỉ hoạt động

5

6

1+1=2

Thành viên bị đình chỉ hoạt động

7

Cu Tồ

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

8

9

1+1=2

Thành viên bị đình chỉ hoạt động

10

Cu Tồ

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

11

12

Cu Tồ

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

14

Cu Tồ

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

15

Cu Tồ

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

17

18

Cu Tồ

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂

19

1+1=2

Thành viên bị đình chỉ hoạt động

20

Bài Viết Liên Quan

Quảng Cáo

Có thể bạn quan tâm

Toplist được quan tâm

Quảng cáo

Xem Nhiều

Quảng cáo

Chúng tôi

Điều khoản

Trợ giúp

Mạng xã hội