Xin các Thầy giúp code thêm dữ liệu vào Excel từ file Text (.txt) !!! (1 người xem)

[ducky2301]

_ Em có 1 file excel và nhiều file text chứa số điện thoại. Dữ liệu chỉ có 1 cột, nhưng có rất nhiều dòng, file excel có trên 100.000 dòng, còn các file text thì trên 1000 dòng.

_ Em đã tạo sẵn 1 Form trong file Excel. Trên Form chỉ có 1 Button và 1 Label. Em muốn khi bấm Button sẽ cho em chọn file text và add cái cột số điện thoại trong file text đó vào Cell tiếp theo của cột số điện thoại trong file excel. Khi add xong thì tên file vừa add sẽ hiện lên trong bảng Label.

_ Có file ví dụ đính kèm bên dưới. Xin các Thầy và các Bạn giúp với, cám ơn nhiều

 

[siwtom]

_ Em có 1 file excel và nhiều file text chứa số điện thoại. Dữ liệu chỉ có 1 cột, nhưng có rất nhiều dòng, file excel có trên 100.000 dòng, còn các file text thì trên 1000 dòng.

_ Em đã tạo sẵn 1 Form trong file Excel. Trên Form chỉ có 1 Button và 1 Label. Em muốn khi bấm Button sẽ cho em chọn file text và add cái cột số điện thoại trong file text đó vào Cell tiếp theo của cột số điện thoại trong file excel. Khi add xong thì tên file vừa add sẽ hiện lên trong bảng Label.

_ Có file ví dụ đính kèm bên dưới. Xin các Thầy và các Bạn giúp với, cám ơn nhiều

Để chọn tập tin txt thì cần gì tới Form? Còn tên tập tin vừa được chọn thì cũng có thể hiển thị trên sheet, vd. trong cột C.

Bạn muốn mỗi lần chỉ chọn 1 tập tin? Thế nếu bạn có 10 tập tin txt thì 10 lần nhấn nút?

 

[Quang_Hải]

_ Em có 1 file excel và nhiều file text chứa số điện thoại. Dữ liệu chỉ có 1 cột, nhưng có rất nhiều dòng, file excel có trên 100.000 dòng, còn các file text thì trên 1000 dòng.

_ Em đã tạo sẵn 1 Form trong file Excel. Trên Form chỉ có 1 Button và 1 Label. Em muốn khi bấm Button sẽ cho em chọn file text và add cái cột số điện thoại trong file text đó vào Cell tiếp theo của cột số điện thoại trong file excel. Khi add xong thì tên file vừa add sẽ hiện lên trong bảng Label.

_ Có file ví dụ đính kèm bên dưới. Xin các Thầy và các Bạn giúp với, cám ơn nhiều

Bạn copy hết code này vào Module, trong nút ImportFile bạn cho chạy sub này

Anh Siwtom: tính em thì ít khi hỏi lại. Muốn sao viết vậy, vui thì viết, buồn thì ngó chơi thôi. Khởi động code rồi tự nhiên lòi ra tùm lum cho anh coi.
Nhân tiện cho em hỏi, mình dùng cách này để lấy dữ liệu và dùng FileSystemObject thì ưu khuyết điểm nào vậy anh?

Sub OpenTextFile()
Dim Fname, LineFromFile, Temp(1 To 100000, 1 To 1), K
Fname = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , False)
If Fname = False Then Exit Sub
Open Fname For Input As #1
Do Until EOF(1)
   Line Input #1, LineFromFile
   LineFromFile = Replace(LineFromFile, ChrW(255), "")
   LineFromFile = Replace(LineFromFile, ChrW(254), "")
   K = K + 1
  Temp(K, 1) = Trim(LineFromFile)
Loop
Close #1
[A65536].End(3).Offset(1).Resize(K).Value = Temp
UserForm1.Label1 = Fname
End Sub

 

[ducky2301]

Để chọn tập tin txt thì cần gì tới Form? Còn tên tập tin vừa được chọn thì cũng có thể hiển thị trên sheet, vd. trong cột C.

Bạn muốn mỗi lần chỉ chọn 1 tập tin? Thế nếu bạn có 10 tập tin txt thì 10 lần nhấn nút?

Thầy nói có lý nhỉ, chỉ cần cái nút bấm chạy Macro cũng được rồi ha . Còn chọn được nhiều file thì càng tốt, do trước em giờ làm cứ mở từng file lên copy rồi lại quên mở file nào, nên chỉ nghĩ mở 1 file

 

[ducky2301]

Bạn copy hết code này vào Module, trong nút ImportFile bạn cho chạy sub này

Anh Siwtom: tính em thì ít khi hỏi lại. Muốn sao viết vậy, vui thì viết, buồn thì ngó chơi thôi. Khởi động code rồi tự nhiên lòi ra tùm lum cho anh coi.
Nhân tiện cho em hỏi, mình dùng cách này để lấy dữ liệu và dùng FileSystemObject thì ưu khuyết điểm nào vậy anh?

Sub OpenTextFile()
Dim Fname, LineFromFile, Temp(1 To 100000, 1 To 1), K
Fname = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , False)
If Fname = False Then Exit Sub
Open Fname For Input As #1
Do Until EOF(1)
   Line Input #1, LineFromFile
   LineFromFile = Replace(LineFromFile, ChrW(255), "")
   LineFromFile = Replace(LineFromFile, ChrW(254), "")
   K = K + 1
  Temp(K, 1) = Trim(LineFromFile)
Loop
Close #1
[A65536].End(3).Offset(1).Resize(K).Value = Temp
UserForm1.Label1 = Fname
End Sub

Cám ơn Thầy nhiều lắm, theo góp ý của Thầy siwtom, Thầy có thể giúp em làm sao mở luôn 1 folder không . Vì có lúc không chỉ 10 file mà đến hơn 50 file . Cám ơn Thầy nhiều nha...

 

[siwtom]

Thầy nói có lý nhỉ, chỉ cần cái nút bấm chạy Macro cũng được rồi ha . Còn chọn được nhiều file thì càng tốt, do trước em giờ làm cứ mở từng file lên copy rồi lại quên mở file nào, nên chỉ nghĩ mở 1 file

Hãy thực hiện các bước

1. Xóa Sub ImportFile
2. Remove UserForm1
3. Thêm code sau vào Module1

Sub Import()
Dim index As Long, k As Long, n As Long, linecount As Long, text As String, AddedFiles() As String
Dim rng As Range, fso As Object, ts As Object, Arr() As String, files, lines
    files = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
    If IsArray(files) Then
'        xoa du lieu cu trong cot C
        Sheet1.Range("C2:C1000").ClearContents
'        o trong dau tien
        Set rng = Sheet1.Range("A65536").End(xlUp).Offset(1)
'        tao doi tuong
        Set fso = CreateObject("Scripting.FileSystemObject")
'        mang chua ten cac tap tin duoc chon
        ReDim Preserve AddedFiles(1 To 1)
'        duyet tung tap tin duoc chon
        For index = LBound(files) To UBound(files)
'            n la so dong co du lieu trong tap tin hien dang duoc xet
            n = 0
'            mo tap tin
            Set ts = fso.OpenTextFile(files(index), 1, , -2)
'            doc tat ca cac dong cua tap tin vao mang lines
            lines = Split(ts.ReadAll, vbCrLf)
'            neu tap tin co it nhat 1 dong, khong la tap tin rong
            If UBound(lines) >= 0 Then
'                so dong
                linecount = UBound(lines) + 1
'                mang chua du lieu - so dien thoai
                ReDim Arr(1 To linecount, 1 To 1)
'                duyet tung dong
                For r = 1 To linecount
'                    loai cac ky tu dau cach (do tap tin cua ban co nhung dau cach sau moi so dien thoai)
                    text = Trim(lines(r - 1))
'                    neu du lieu khong rong thi them vao mang Arr
                    If text <> "" Then
                        n = n + 1
                        Arr(n, 1) = text
                    End If
                Next r
            End If
'            neu tap tin hien hanh co it nhat 1 dong du lieu thi them ten cua no vao mang AddedFiles,
'            va "dap" mang Arr xuong Sheet
            If n Then
                k = k + 1
                ReDim Preserve AddedFiles(1 To k)
                AddedFiles(k) = files(index)
                rng.Resize(n).Value = Arr
                Set rng = rng.Offset(n)
            End If
        Next index
'        nhap danh sach tap tin vao cot C
        If k Then Sheet1.Range("C2").Resize(k).Value = WorksheetFunction.Transpose(AddedFiles)
        
        Set ts = Nothing
        Set fso = Nothing
    End If
End Sub

4. Gán Sub Import cho "nút" trên sheet
5. Thêm 1 dòng đầu
6. Nhập A1 = Số điện thoại, C1 = Các tập tin mới thêm

 

[siwtom]

Bạn copy hết code này vào Module, trong nút ImportFile bạn cho chạy sub này

Anh Siwtom: tính em thì ít khi hỏi lại. Muốn sao viết vậy, vui thì viết, buồn thì ngó chơi thôi. Khởi động code rồi tự nhiên lòi ra tùm lum cho anh coi.
Nhân tiện cho em hỏi, mình dùng cách này để lấy dữ liệu và dùng FileSystemObject thì ưu khuyết điểm nào vậy anh?

Sub OpenTextFile()
Dim Fname, LineFromFile, Temp(1 To 100000, 1 To 1), K
Fname = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , False)
If Fname = False Then Exit Sub
Open Fname For Input As #1
Do Until EOF(1)
   Line Input #1, LineFromFile
   LineFromFile = Replace(LineFromFile, ChrW(255), "")
   LineFromFile = Replace(LineFromFile, ChrW(254), "")
   K = K + 1
  Temp(K, 1) = Trim(LineFromFile)
Loop
Close #1
[A65536].End(3).Offset(1).Resize(K).Value = Temp
UserForm1.Label1 = Fname
End Sub

Có nhiều công cụ khác nhau, bạn thấy công cụ nào vừa đủ dùng thì đều được. Nếu bạn thạo cách thao tác với những hàm, sub của module VBA thì cứ dùng.
Bạn có thể dùng những hàm VBA mà không phải tạo đối tượng nào cả vì module VBA được load mặc định (cùng với các thư viện Excel, Office, stodole, VBAProject). Khi bạn dùng fso thì bạn phải tạo đối tượng FileSystemObject. Khi bạn có đối tượng đó rồi thì bạn có thể gọi các phương thức của nó. Không chỉ là đọc tập tin txt mà có thể làm mọi chuyện dính dáng tới "file system". Ví dụ tạo thư mục. Tất nhiên bạn có thể dùng VBA.MkDir để tạo thư mục nhưng nếu thao tác với tiếng Việt có dấu unicode thì có thể tèo. Tương tự khi dùng VBA.Dir

Về code của bạn thì tôi có 2 góp ý.

1. Bạn biết là người hỏi ghi tập tin mã unicode (chả hiểu sao lại unicode mà không là ANSI khi chỉ có toàn chữ số) nên chủ ý loại 2 bai &HFF = 255, &HFE = 254. Nhưng bạn hãy để ý A26 có "gì đó" ở đầu. Tại sao? Vì bạn tìm để xóa ChrW(255), ChrW(254). ChrW() luôn trả về ký tự có 2 bai. ChrW(255) là 1 ký tự unicode gồm 2 bai là &HFF và &H00. Rõ ràng Replace không tìm thấy "cụm 2 bai" như thế để biến chúng thành "". Vì thế bạn có A26 = "˙ţ0903646358"

Ta sửa thành

LineFromFile = Replace(LineFromFile, Chr(255), "")
LineFromFile = Replace(LineFromFile, Chr(254), "")

Tức ta tìm để xóa 1 bai &HFF (&HFE) chứ không phải "cụm 2 bai" &HFF, &H00

2. Nên kiểm tra và nhập vào Temp chỉ khi Trim(LineFromFile) <> "". Hiện thời code không loại các dòng trống nếu có.

 

[ducky2301]

Em cám ơn Thầy rất nhiều, code của Thầy có giải thích từng dòng luôn, quá là tuyệt vời

 

[xuantam1991]

Anh em cho mình hỏi.. mình muốn sửa macro này để import data nhưng với yêu cầu là xóa hết dữ liệu cũ trước khi nhập và dữ liệu được nhập từ ô A1 nhưng sửa xong toàn nhập từ A2 nên khi link sang các sheet khác bị lỗi.. Anh em chỉnh giúp với..

 

[Quang_Hải]

Anh em cho mình hỏi.. mình muốn sửa macro này để import data nhưng với yêu cầu là xóa hết dữ liệu cũ trước khi nhập và dữ liệu được nhập từ ô A1 nhưng sửa xong toàn nhập từ A2 nên khi link sang các sheet khác bị lỗi.. Anh em chỉnh giúp với..

Sửa tạm thế này

Private Sub CommandButton1_Click()
Dim Fname, LineFromFile, Temp(1 To 100000, 1 To 1), K
Fname = Application.GetOpenFilename("Text Files (*.csv), *.txt", , , , False)
If Fname = False Then Exit Sub
Open Fname For Input As #1
Do Until EOF(1)
   Line Input #1, LineFromFile
   LineFromFile = Replace(LineFromFile, ChrW(255), "")
   LineFromFile = Replace(LineFromFile, ChrW(254), "")
   K = K + 1
  Temp(K, 1) = Trim(LineFromFile)
Loop
Close #1
ActiveSheet.UsedRange.ClearContents
[A1].Resize(K).Value = Temp
End Sub

 

[xuantam1991]

Cam on anh nhieu. Em da sua duoc thay offset(1) thanh offset(0). Em co them van de la du lieu file text cua em gom co 7 cot. Ma sau import vao excel du lieu khong tach ra cac cot A. B. C... Ma chi cobo cot A.. Anh chinh code giup em voi.

 

[Quang_Hải]

Cam on anh nhieu. Em da sua duoc thay offset(1) thanh offset(0). Em co them van de la du lieu file text cua em gom co 7 cot. Ma sau import vao excel du lieu khong tach ra cac cot A. B. C... Ma chi cobo cot A.. Anh chinh code giup em voi.

Bài viết không dấu được xếp vào nhóm phạm quy sẽ bị xóa.

 

[xuantam1991]

Anh thông cảm nhé. Em dùng điện thoại k đánh có dấu hi. Anh giúp em sửa công thức cho dữ liệu tách vào từng cột với dữ liệu text của em có 7 cột mà sang excel nó chỉ có ở cột A thôi. Cảm ơn anh nhiều.

 

[Quang_Hải]

Anh thông cảm nhé. Em dùng điện thoại k đánh có dấu hi. Anh giúp em sửa công thức cho dữ liệu tách vào từng cột với dữ liệu text của em có 7 cột mà sang excel nó chỉ có ở cột A thôi. Cảm ơn anh nhiều.

Thay code này vào chắc là được

Sub ImportTextToExcel()
Dim fso As Object, FilesToOpen, TextSource As Object, TotalLines, Res()
Dim ItemsOfLine, TextItem, Des As Range, Delimiter
Dim K As Long, X As Byte, Cols As Integer, LineNum As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Set Des = [a1]
Delimiter = vbTab
FilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
If Not IsArray(FilesToOpen) Then Exit Sub
For X = LBound(FilesToOpen) To UBound(FilesToOpen)
   K = 0
   Set TextSource = fso.OpenTextFile(FilesToOpen(X), 1, , -2)
   TotalLines = Split(TextSource.ReadAll, vbCrLf)
   ReDim Res(1 To 1 + UBound(TotalLines), 1 To 1)
   For LineNum = LBound(TotalLines) To UBound(TotalLines)
      ItemsOfLine = TotalLines(LineNum)
      TextItem = Split(ItemsOfLine, Delimiter)
      If UBound(Res, 2) < UBound(TextItem) + 1 Then
          ReDim Preserve Res(1 To 1 + UBound(TotalLines), 1 To 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
   Des.Resize(K, UBound(Res, 2)) = Res
   Set Des = Des.Offset(K)
Next
End Sub

 

[xuantam1991]

Thay code này vào chắc là được

Sub ImportTextToExcel()
Dim fso As Object, FilesToOpen, TextSource As Object, TotalLines, Res()
Dim ItemsOfLine, TextItem, Des As Range, Delimiter
Dim K As Long, X As Byte, Cols As Integer, LineNum As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Set Des = [a1]
Delimiter = vbTab
FilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
If Not IsArray(FilesToOpen) Then Exit Sub
For X = LBound(FilesToOpen) To UBound(FilesToOpen)
   K = 0
   Set TextSource = fso.OpenTextFile(FilesToOpen(X), 1, , -2)
   TotalLines = Split(TextSource.ReadAll, vbCrLf)
   ReDim Res(1 To 1 + UBound(TotalLines), 1 To 1)
   For LineNum = LBound(TotalLines) To UBound(TotalLines)
      ItemsOfLine = TotalLines(LineNum)
      TextItem = Split(ItemsOfLine, Delimiter)
      If UBound(Res, 2) < UBound(TextItem) + 1 Then
          ReDim Preserve Res(1 To 1 + UBound(TotalLines), 1 To 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
   Des.Resize(K, UBound(Res, 2)) = Res
   Set Des = Des.Offset(K)
Next
End Sub

Anh ơi vẫn chưa được dữ liệu text của em được xuất ra từ phần mềm thiết kế cơ khí có dạng tọa độ X, Y, Z hơi lạ so với bình thường,,
Anh xem files đính kèm giúp em với.. cả tuần em loay hoay mãi k được.. mà text thì mạng trong công ty không copy ra ngoài được.. hnay mới kiếm được file txt tương tự..

 

[Quang_Hải]

Anh ơi vẫn chưa được dữ liệu text của em được xuất ra từ phần mềm thiết kế cơ khí có dạng tọa độ X, Y, Z hơi lạ so với bình thường,,
Anh xem files đính kèm giúp em với.. cả tuần em loay hoay mãi k được.. mà text thì mạng trong công ty không copy ra ngoài được.. hnay mới kiếm được file txt tương tự..

Với file text đính kèm, bạn muốn kết quả thế nào? Bạn tưởng ai cũng đọc được suy nghĩ của bạn hả?
Nếu muốn được giúp thì vui lòng cho kết quả tạm vài dòng trong file excel nhá. Xem file text chẳng hiểu gì cả.

 

[xuantam1991]

hihi xin lỗi anh nhé.. em hỏi không rõ...

Em muốn khi import vào excel các dữ liệu tách ra các cột A, B, C để em link sang sheet khác.. hiện tại em import vào nó chỉ vào có một cột thôi à. Anh xem file đính kèm mới giúp em với nhé.. thank anh nhiều!!

 

[Quang_Hải]

hihi xin lỗi anh nhé.. em hỏi không rõ...

Em muốn khi import vào excel các dữ liệu tách ra các cột A, B, C để em link sang sheet khác.. hiện tại em import vào nó chỉ vào có một cột thôi à. Anh xem file đính kèm mới giúp em với nhé.. thank anh nhiều!!

Đây là những gì mình nhìn thấy trong file Text

Nhưng trong file Excel của bạn thì thế này

Mình không làm nổi rồi

 

[xuantam1991]

Sorry anh dữ liệu trong file excel là file text cũ.. em tự tạo bằng cách đánh cách nhau bởi Tab khi Ipmport vào thì oki.. Nó ở các cột khác nhau.. nhưng file thực tế giống files test thì nó lại không tách được Anh xem có cách nào giúp em với!!

 

[Quang_Hải]

Sorry anh dữ liệu trong file excel là file text cũ.. em tự tạo bằng cách đánh cách nhau bởi Tab khi Ipmport vào thì oki.. Nó ở các cột khác nhau.. nhưng file thực tế giống files test thì nó lại không tách được Anh xem có cách nào giúp em với!!
View attachment 127630

Tìm dòng code
Delimiter = VbTab
và thay bằng
Delimiter = "+"

May mắn thì trúng, nếu không trúng thì mình xin thua.
Cũng nên lưu ý là mỗi dạng file text thường rất hay không giống nhau, nên cần phải biết lúc xuất ra phải text người ta đã dùng ký tự gì để tạo phân cách thì mới xử lý được.
Trong file text của bạn hình như là người ta dùng dấu + để phân cách

 

[xuantam1991]

trong file của em không phải cách nhau bằng dấu + đâu anh à!! Dấu + là dấu của tọa độ.. nó có thể là + hoặc -. file thì là do phần mềm khác tự xuất ra nên không biết nó cách nhau bằng cái gì cả.. (

 

[xuantam1991]

Có vẻ nó cách nhau bởi dấu Cách anh à!! Em vừa thử khá oki.. chỉnh lại chút chắc là ngon.. Thank anh nhiệt tình giúp đỡ nha..

 

[Quang_Hải]

trong file của em không phải cách nhau bằng dấu + đâu anh à!! Dấu + là dấu của tọa độ.. nó có thể là + hoặc -. file thì là do phần mềm khác tự xuất ra nên không biết nó cách nhau bằng cái gì cả.. (

Thì cứ mở file text kiểm ta xem dấu gì và thay vào chỗ đó