Nhập tự động dữ liệu từ file notepad sang Excel

Liên hệ QC
ngocminh2018hp đã viết:
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
Nhấp chuột vào đây để mở rộng...
Code cho bạn:
PHP: 
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
 
vanthinh3101 đã viết:
Code cho bạn:
PHP: 
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
Nhấp chuột vào đây để mở rộng...

Thank you very much , bro

Have a nice day
 
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 ?
 
ngocminh2018hp đã viết:
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 ?
Nhấp chuột vào đây để mở rộng...
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.
 
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 ạ
 

File đính kèm

  • MAU_SL.rar
    16.6 KB · Đọc: 4
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.
 

File đính kèm

  • Book1.xlsx
    12.1 KB · Đọc: 13
  • data.rar
    22.6 KB · Đọc: 14
Lần chỉnh sửa cuối:
befaint đã viết:
.
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.
Nhấp chuột vào đây để mở rộng...
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 ạ.
 
Lần chỉnh sửa cuối:
truongchanhtin đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Bạn thử code này:
Mã: 
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
 
huuthang_bd đã viết:
Bạn thử code này:
Mã: 
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
Nhấp chuột vào đây để mở rộng...
Code chạy được rồi ạ, em cảm ơn ạ.
 
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.
 

File đính kèm

  • New folder.rar
    14.4 KB · Đọc: 9
locbanh đã viết:
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.
Nhấp chuột vào đây để mở rộng...

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.
 

File đính kèm

  • Gop file TXT.xlsm
    19.9 KB · Đọc: 14
locbanh đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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
 
ndu96081631 đã viết:
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:
Mã: 
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?)
Nhấp chuột vào đây để mở rộ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 ạ
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

T
  • Question
Dãn dòng tự động
Trả lời
0
Đọc
24
thanhlongenet
T
dunghtgiga
Không cho người khác chỉnh sửa nội dung bảng tính
Trả lời
3
Đọc
98
YêuCN
Y
T
Thống kê ngày hết hạn của sản phẩm
Trả lời
11
Đọc
233
tranphuson
T
T
tự động giãn dòng theo dữ liệu
    • Buồn
Trả lời
2
Đọc
53
SA_DQ
SA_DQ
T
Hướng dẫn lấy dữ liệu từ sheet1 sang sheet2 bằng VBA
2
Trả lời
24
Đọc
2K
meomap1904
meomap1904
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom