Nhập tự động dữ liệu từ file notepad sang Excel (2 người xem)

[vanthinh3101]

Dear bạn

cảm ơn b , tớ giải quyết được vấn đề cho sheet IN rồi

Tuy nhiên còn sheet OUt tớ ko hiểu lắm , bạn giải thích giúp t được ko ?

Đồng thời , với file text xuất , định dạng các cột trong file ko giống so với file text IN , nên theo tớ nghĩ code cho OUT sẽ khác chứ bạn ?

thank for support

Code cho bạn:

Public Sub ImportTxt_ToExcel_sheetOut()
    Dim Fso As Object, TextSource As Object, TotalLines, Item, Tmp
    Dim K As Long, I As Long, J As Long, sArr(1 To 500000, 1 To 4), lR As Long
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Application.ScreenUpdating = False
    
    MsgBox "Chon File TXT Import" & Chr(10) & "(Co the chon Nhieu File de Import)"
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "TXT File", "*.txt", 1
        If Not .Show = -1 Then
            MsgBox "Ban chua chon File", vbInformation, "----Mr.GPE----"
            Exit Sub
        End If
    On Error Resume Next
    For Each Item In .SelectedItems
        Set TextSource = Fso.OpenTextFile(Item, 1, , -2)
            TotalLines = Split(TextSource.ReadAll, vbCrLf)
            
            For I = 0 To UBound(TotalLines)
                If Len(TotalLines(I)) Then
                Tmp = Split(TotalLines(I), ",")
                    K = K + 1: sArr(K, 1) = Tmp(7)
                    sArr(K, 2) = Tmp(3): sArr(K, 4) = Right(sArr(K, 1), 3)
                    sArr(K, 3) = DateSerial(Left(Tmp(0), 4), Mid(Tmp(0), 5, 2), Right(Tmp(0), 2))
                End If
            Next
    Next
    End With
    If K Then
        lR = Sheet31.Range("A" & Rows.Count).End(xlUp).Row + 1
        Sheet31.Range("A" & lR).Resize(K, 4).Value = sArr
    End If
    MsgBox "Done!"
    Application.ScreenUpdating = True
End Sub

 

[ngocminh2018hp]

Code cho bạn:

Public Sub ImportTxt_ToExcel_sheetOut()
    Dim Fso As Object, TextSource As Object, TotalLines, Item, Tmp
    Dim K As Long, I As Long, J As Long, sArr(1 To 500000, 1 To 4), lR As Long
   
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Application.ScreenUpdating = False
   
    MsgBox "Chon File TXT Import" & Chr(10) & "(Co the chon Nhieu File de Import)"
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Filters.Add "TXT File", "*.txt", 1
        If Not .Show = -1 Then
            MsgBox "Ban chua chon File", vbInformation, "----Mr.GPE----"
            Exit Sub
        End If
    On Error Resume Next
    For Each Item In .SelectedItems
        Set TextSource = Fso.OpenTextFile(Item, 1, , -2)
            TotalLines = Split(TextSource.ReadAll, vbCrLf)
           
            For I = 0 To UBound(TotalLines)
                If Len(TotalLines(I)) Then
                Tmp = Split(TotalLines(I), ",")
                    K = K + 1: sArr(K, 1) = Tmp(7)
                    sArr(K, 2) = Tmp(3): sArr(K, 4) = Right(sArr(K, 1), 3)
                    sArr(K, 3) = DateSerial(Left(Tmp(0), 4), Mid(Tmp(0), 5, 2), Right(Tmp(0), 2))
                End If
            Next
    Next
    End With
    If K Then
        lR = Sheet31.Range("A" & Rows.Count).End(xlUp).Row + 1
        Sheet31.Range("A" & lR).Resize(K, 4).Value = sArr
    End If
    MsgBox "Done!"
    Application.ScreenUpdating = True
End Sub

Thank you very much , bro

Have a nice day

 

[vanthinh3101]

Cảm ơn very much , bro

Have a nice day

Bạn vừa vi phạm nội quy diễn đàn (làm ảnh hưởng đến sự trong sáng của tiếng Việt) rồi đấy.
Lưu ý tìm hiểu nội quy: https://www.giaiphapexcel.com/diendan/help/terms/
Chúc bạn ngày vui!

 

[ngocminh2018hp]

Cảm ơn bạn đã nhắc nhở

Mình xin rút kinh nghiệm

Mình còn chút thắc mắc bạn hướng dẫn giúp minhg nhé :

_ mình muốn trích xuát thêm nhiều thông tin tu file text vào file exel ( ko chỉ có 4 cột như file exel đã làm ) thì mình cần chỉnh trong code như thế nào ?

Bạn hướng dẫn đc ko ?

 

[vanthinh3101]

Cảm ơn bạn đã nhắc nhở

Mình xin rút kinh nghiệm

Mình còn chút thắc mắc bạn hướng dẫn giúp minhg nhé :

_ mình muốn trích xuát thêm nhiều thông tin tu file text vào file exel ( ko chỉ có 4 cột như file exel đã làm ) thì mình cần chỉnh trong code như thế nào ?

Bạn hướng dẫn đc ko ?

Bạn không nói rõ là thêm các thông tin nào thì không thể giúp được.
Nếu có thông tin rồi thì bạn có biết về VBA không? Nếu bạn biết thì chắc tôi sẽ hướng dẫn được.

 

[thaolb]

Chào mọi người!
Mình là dân mới tập tọe, m đang có phần chạy nhập SL, nhưng hiện đang làm rất thủ công. Mình muốn nhờ mọi người giúp mình đưa file notepad vào excel theo mẫu m đã gửi. Với mỗi một file notepad thì tương ứng với một sheet đã được đặt tên tương ứng trong excel. Vì m có rất nhiều file notepad cần phải đưa vào để chạy chương trình. Xin cảm ơn và mong hồi âm của mọi người ạ

 

[truongchanhtin]

Thân chào các anh chị trên diễn đàn!

Em muốn copy dữ liệu từ nhiều file (khoảng 20 file mỗi lần ạ) xxx.log vào cột A của file excel với điều kiện như sau:
1. chỉ copy những dòng có dòng chữ: link-down Blocking (như em bôi đỏ trong file kết quả mong muốn cho dễ nhìn ấy ạ)
2. Hết mỗi file đến file khác thì để 1 dòng để tên của cái file log ạ, mục đích là phân ra để dễ check cái file nay ạ (như dòng 1 và dòng 48 ạ)
Nhờ các anh chị xem file em đính kèm và giúp đỡ ạ.

Em cảm ơn.

 

[befaint]

(file test.log là file dữ liệu, file excel là file kết quả )

File đó đâu bạn? Trông nó có đẹp không?

 

[truongchanhtin]

File đó đâu bạn? Trông nó có đẹp không?

Dạ em mới sửa lại một chút và upload lại rồi ạ, nhờ anh/chị xem giúp ạ.

 

[befaint]

2. Hết mỗi file đến file khác thì để 1 dòng để tên của cái file log ạ, mục đích là phân ra để dễ

.
Không ai làm thế cả. Sai chuẩn cấu trúc dữ liệu rồi.

Chí ít thế này.



Phần nội dung ở cột B lý ra phải tách ra vài cột nữa.

 

[truongchanhtin]

.
Không ai làm thế cả. Sai chuẩn cấu trúc dữ liệu rồi.

Chí ít thế này.

View attachment 270861

Phần nội dung ở cột B lý ra phải tách ra vài cột nữa.

Dạ, như file anh/chị gửi cũng được ạ (vì phần nội dung đó có người khác làm cái cấu trúc nó có thể không giống vầy ạ, phần thời gian đầu mỗi dòng ko có ạ, nên không biết là có tách được ko ạ).
Em chỉ mong check được cái port nào bị: link-down Blocking la được ạ.
Em cảm ơn ạ.

 

[huuthang_bd]

Thân chào các anh chị trên diễn đàn!

Em muốn copy dữ liệu từ nhiều file (khoảng 20 file mỗi lần ạ) xxx.log vào cột A của file excel với điều kiện như sau:
1. chỉ copy những dòng có dòng chữ: link-down Blocking (như em bôi đỏ trong file kết quả mong muốn cho dễ nhìn ấy ạ)
2. Hết mỗi file đến file khác thì để 1 dòng để tên của cái file log ạ, mục đích là phân ra để dễ check cái file nay ạ (như dòng 1 và dòng 48 ạ)
Nhờ các anh chị xem file em đính kèm và giúp đỡ ạ.

Em cảm ơn.

Bạn thử code này:

Sub FilterTextFiles()
Const sPattern As String = "*link-down  Blocking*"
Dim i As Long, k As Long, FileNum As Long, sLine As String, bCheck As Boolean
Dim aResult(1 To 100000, 1 To 1)
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Clear
    .Filters.Add "Log files", "*.log"
    If .Show Then
        For i = 1 To .SelectedItems.Count
            FileNum = FreeFile()
            Open .SelectedItems(i) For Input As #FileNum
            bCheck = False
            Do While Not EOF(FileNum)
                Line Input #FileNum, sLine
                If sLine Like sPattern Then
                    If Not bCheck Then
                        bCheck = True
                        k = k + 1
                        aResult(k, 1) = Mid(.SelectedItems(i), InStrRev(.SelectedItems(i), "\") + 1)
                    End If
                    k = k + 1
                    aResult(k, 1) = sLine
                End If
            Loop
            Close FileNum
        Next
    End If
End With
Range("A1:A" & Range("A100000").End(xlUp).Row).ClearContents
If k > 0 Then Range("A1:A" & k).Value = aResult
End Sub

 

[truongchanhtin]

Bạn thử code này:

Sub FilterTextFiles()
Const sPattern As String = "*link-down  Blocking*"
Dim i As Long, k As Long, FileNum As Long, sLine As String, bCheck As Boolean
Dim aResult(1 To 100000, 1 To 1)
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Clear
    .Filters.Add "Log files", "*.log"
    If .Show Then
        For i = 1 To .SelectedItems.Count
            FileNum = FreeFile()
            Open .SelectedItems(i) For Input As #FileNum
            bCheck = False
            Do While Not EOF(FileNum)
                Line Input #FileNum, sLine
                If sLine Like sPattern Then
                    If Not bCheck Then
                        bCheck = True
                        k = k + 1
                        aResult(k, 1) = Mid(.SelectedItems(i), InStrRev(.SelectedItems(i), "\") + 1)
                    End If
                    k = k + 1
                    aResult(k, 1) = sLine
                End If
            Loop
            Close FileNum
        Next
    End If
End With
Range("A1:A" & Range("A100000").End(xlUp).Row).ClearContents
If k > 0 Then Range("A1:A" & k).Value = aResult
End Sub

Code chạy được rồi ạ, em cảm ơn ạ.

 

[locbanh]

Kính chào các Thầy cô và các anh chị,
Chúc mọi người đầu năm May Mắn - Manh Khỏe - Phát Tài - Phát Lộc - Gia Đình Bình An

Em có việc cần mọi người giup
Hàng ngày em lấy dữ liệu từ các file txt do chường tình xuất ra rất nhiều ngày (15-20 ngày), nên khi tìm dữ liệu ngày nào thì phải mở file ngày đó lên và tìm sau đó paste vào excel (tổng)
nên e cần làm 20 file txt bỏ và 1 folder sau đó mở 1 file excel new chạy VBA tất cả 20 txt sẻ được bỏ vào đậy (lây luôn cả tiêu đề)
vd: file thứ nhât (D:\test.txt) có 3 dòng 3 cột thì khi chép vào file excel (new) là
côt A1, A2, A3 điều ghi là D:\test.txt và các dữ liêu sẽ được chép vào cột B trở đi
.dong A4 là file kế tiếp thực hiện như trên cho đến file cuối cùng.

Nhờ các Thầy cô và các anh chị em giúp đỡ, e xin cảm ơn rất nhiều.

 

[locbanh]

Kính chào các Thầy cô và các anh chị,
Chúc mọi người đầu năm May Mắn - Manh Khỏe - Phát Tài - Phát Lộc - Gia Đình Bình An

Em có việc cần mọi người giup
Hàng ngày em lấy dữ liệu từ các file txt do chường tình xuất ra rất nhiều ngày (15-20 ngày), nên khi tìm dữ liệu ngày nào thì phải mở file ngày đó lên và tìm sau đó paste vào excel (tổng)
nên e cần làm 20 file txt bỏ và 1 folder sau đó mở 1 file excel new chạy VBA tất cả 20 txt sẻ được bỏ vào đậy (lây luôn cả tiêu đề)
vd: file thứ nhât (D:\test.txt) có 3 dòng 3 cột thì khi chép vào file excel (new) là
côt A1, A2, A3 điều ghi là D:\test.txt và các dữ liêu sẽ được chép vào cột B trở đi
.dong A4 là file kế tiếp thực hiện như trên cho đến file cuối cùng.

Nhờ các Thầy cô và các anh chị em giúp đỡ, e xin cảm ơn rất nhiều.

Chào các anh chị em, sau thời gian mò mẵm sao chép (ăn cắp hihihi) trên mạng, tuy không đúng theo yêu cầu, nhưng cũng đáp ứng được công việc của e, nên e xin phép đưa lên, để mọi người tham khảo.
Ghi chú: chỉ áp cho file txt ko có dấu thôi, vì có dấu nó sẽ bị lỗi font.

 

[BuiQuangThuan]

Chào các anh chị em, sau thời gian mò mẵm sao chép (ăn cắp hihihi) trên mạng, tuy không đúng theo yêu cầu, nhưng cũng đáp ứng được công việc của e, nên e xin phép đưa lên, để mọi người tham khảo.
Ghi chú: chỉ áp cho file txt ko có dấu thôi, vì có dấu nó sẽ bị lỗi font.

Bác đã lấy được dữ liệu rồi có thể dùng chức năng text to column để tách ra theo ý mình hoặc có thể xử lí thêm để đạt được mong muốn của bản thân là được

 

[chuthanhcong]

Tức là mỗi file txt ta sẽ lấy cột 3 (tính từ dòng 3) rồi đưa vào 1 cột trên bảng tính ---> Vậy 1000 file txt sẽ tương ứng 1000 cột trên Excel, đúng không? Vậy chắc chắc phải dùng định dạng file Excel 2007 trở lên rồi?
Dùng thử code này xem:

Sub Main()
  Dim vFile, txtFile, aCols, aRows, Arr
  Dim sAll As String, tmp As String
  Dim fso As Object
  Dim lR As Long, lC As Long, n As Long, t As Double
  On Error Resume Next
  vFile = Application.GetOpenFilename("Text Files, *.txt", , , , True)
  If TypeName(vFile) = "Variant()" Then
    t = Timer
    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each txtFile In vFile
      With fso.OpenTextFile(txtFile, 1)
        sAll = .ReadAll
        .Close
      End With
      aRows = Split(sAll, vbCrLf)
      If Not IsArray(Arr) Then ReDim Arr(1 To UBound(aRows), 1 To UBound(vFile))
      lC = lC + 1: lR = 0
      For n = 2 To UBound(aRows)
        tmp = CStr(aRows(n))
        If Len(tmp) Then
          lR = lR + 1
          aCols = Split(tmp, vbTab)
          Arr(lR, lC) = aCols(2)
        End If
      Next
    Next
    Set fso = Nothing
    If lR Then
      Range("A1").Resize(lR, lC).Value = Arr
      MsgBox "Done!", , Format(Timer - t, "0.000000")
    End If
  End If
End Sub

Thí nghiệm thử vài chục file 1 lần cho chắc nha (vì không biết chạy 1 lần 1000 file có chậm lắm không?)

thầy ơi cho e hỏi e muốn nhập dữ liệu từ file txt chuyển sang file excel vào các cột và dòng theo ý mình thì có làm được không ạ

 

[Maika8008]

thầy ơi cho e hỏi e muốn nhập dữ liệu từ file txt chuyển sang file excel vào các cột và dòng theo ý mình thì có làm được không ạ

Thầy đó đã không vào diễn đàn 2 năm rưỡi nay rồi.

Tôi trả lời thay là: có.

 

[chuthanhcong]

Thầy đó đã không vào diễn đàn 2 năm rưỡi nay rồi.

Tôi trả lời thay là: có.

pro có biết chỉ e mới ạ

 

[Hoàng Tuấn 868]

Thầy đó đã không vào diễn đàn 2 năm rưỡi nay rồi.
Tôi trả lời thay là: có.

Nếu nhận là "Pro" thì trả lời đi anh.