Mở file .txt và lưu vào sheet trong excel dùng VBA (1 người xem)

[anpn79]

Hi all,

Mình có 1 folder chứa khoảng 150 file có đuôi .txt, mỗi file khoảng 5.000 dòng lệnh.

Mình muốn làm một thủ tục để mở folder này để lấy nội dung từng file đưa vào từng sheet, tên của từng sheet trùng tên từng file luôn.

Bạn nào biết hỗ trợ mình với, cảm ơn nhiều.

 

[ndu96081631]

Hi all,

Mình có 1 folder chứa khoảng 150 file có đuôi .txt, mỗi file khoảng 5.000 dòng lệnh.

Mình muốn làm một thủ tục để mở folder này để lấy nội dung từng file đưa vào từng sheet, tên của từng sheet trùng tên từng file luôn.

Bạn nào biết hỗ trợ mình với, cảm ơn nhiều.

Thì ít nhất bạn cũng đưa lên đây vài ba file TXT để xem cấu trúc nó thế nào chứ
Ngoài ra bạn cũng phải nói cho mọi người biết dữ liệu trong file TXT sau khi cho vào Excel thì sẽ được bố trí ra sao?
Tóm lại: Cho lên đây 3 file TXT + 1 file Excel mẫu là được
(nén chúng lại rồi gửi lên)

 

[anpn79]

Thanks bạn ndu đã quan tâm, mình gởi nội dung file txt đây.
Mục tiêu như sau:

B1: Unzip file này vào 1 folder nào đó
B2: Tạo userform chọn đường dẫn đến folder này
B3: Tạo một workbook mới
B4: Copy nội dung từng file txt vào từng sheet với tên sheet là tên file txt
B5: Tìm kiếm và thay thế serial number
B6: Save kết quả sang một file khác.

Mình mới nghiên cứu VBA nên còn amatuer, mong các bạn support.

Thanks

 

[anpn79]

Mình bổ sung thêm:
B1: làm tay cũng được
B2 --> B6: dùng thủ tục sub/function để thực hiện

 

[ndu96081631]

Thanks bạn ndu đã quan tâm, mình gởi nội dung file txt đây.
Mục tiêu như sau:

B1: Unzip file này vào 1 folder nào đó
B2: Tạo userform chọn đường dẫn đến folder này
B3: Tạo một workbook mới
B4: Copy nội dung từng file txt vào từng sheet với tên sheet là tên file txt
B5: Tìm kiếm và thay thế serial number
B6: Save kết quả sang một file khác.

Mình mới nghiên cứu VBA nên còn amatuer, mong các bạn support.

Thanks

Lúc cho vào Excel thì bố trí ra sao? Tôi đã nói bạn đưa lên 1 file Excel mẫu rồi cơ mà

 

[anpn79]

Mình gởi file excel đây, sau khi có file này mình sẽ tìm kiếm và lấy thông tin serial number để thống kê tài sản,...

 

[ndu96081631]

Mình gởi file excel đây, sau khi có file này mình sẽ tìm kiếm và lấy thông tin serial number để thống kê tài sản,...

Thì ra là copy toàn bộ nội dung txtfile cho vào sheet. Vậy thì quá dễ
1> Các hàm hổ trợ:

Function GetListFile(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
  Dim sComm As String, tmp As String, tmpFile, Arr
  On Error Resume Next
  If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
  Folder = """" & Folder & """"
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    sComm = "DIR " & Folder & Search & " /ON /B /A-D " & IIf(InSub, "/S", " ") & " >" & tmpFile
    CreateObject("Wscript.Shell").Run "cmd /u /c " & sComm, 0, True
    With .OpenTextFile(tmpFile, 1, , -2)
      tmp = Trim(.ReadAll)
      If Right(tmp, 2) = vbCrLf Then tmp = Left(tmp, Len(tmp) - 2)
      If Len(tmp) Then GetListFile = Split(tmp, vbCrLf)
      .Close
    End With
  End With
  Kill tmpFile
End Function

Function GetValFromTxt(ByVal txtFile As String)
  Dim tmpArr, Arr()
  Dim n As Long, i As Long
  On Error Resume Next
  With CreateObject("Scripting.FileSystemObject")
    If .FileExists(txtFile) Then
      With .OpenTextFile(txtFile, 1, , -2)
        tmpArr = Split(.ReadAll, vbCrLf)
        If IsArray(tmpArr) Then
          ReDim Arr(1 To UBound(tmpArr) + 1, 1 To 1)
          For i = 0 To UBound(tmpArr)
            n = n + 1
            Arr(n, 1) = CStr(tmpArr(i))
          Next
          If n Then GetValFromTxt = Arr
        End If
        .Close
      End With
    End If
  End With
End Function

2> Code chính:

Sub Main()
  Dim sFolder, txtFile As String, sWksName As String
  Dim aFiles, Arr, wkbNew As Workbook
  Dim lCount As Long, i As Long, n As Long, lWksCount As Long
  On Error Resume Next
  With CreateObject("Shell.Application")
    sFolder = .BrowseForFolder(0, "", 1).Self.Path
  End With
  If TypeName(sFolder) = "String" Then
    If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
    aFiles = GetListFile(sFolder, "*.txt", False)
    If IsArray(aFiles) Then
      lCount = UBound(aFiles) + 1
      ReDim Arr(1 To lCount)
      Set wkbNew = Workbooks.Add
      With wkbNew
        lWksCount = lCount - .Sheets.Count
        If lWksCount > 0 Then
          .Worksheets.Add After:=.Sheets(.Sheets.Count), Count:=lWksCount
        End If
      End With
      With CreateObject("Scripting.FileSystemObject")
        For i = 0 To UBound(aFiles)
          txtFile = sFolder & aFiles(i)
          sWksName = Left(aFiles(i), InStrRev(aFiles(i), ".") - 1)
          n = n + 1
          Arr = GetValFromTxt(txtFile)
          With wkbNew.Sheets(n)
            .Range("A1").Resize(UBound(Arr)).Value = Arr
            .Name = [COLOR=#ff0000]Left(sWksName, 31)[/COLOR]
          End With
        Next
      End With
    End If
  End If
End Sub

Bạn lưu ý:
- Có 1 vài tên file dài hơn 31 ký tự, mà tên sheet thì quy định không cho phép dài hơn 31 ký tự, thế nên tôi phải cắt bớt (ở code màu đỏ) ----> Từ đó cũng sẽ có nguy cơ bị trùng tên sheet ---> Bạn ráng chịu nha (tôi không biết)
- Tôi chỉ tạo ra Workbook mới, còn chuyện Save thế nào là tuy bạn
- Khi bấm nút chạy code, sẽ có 1 hộp Browse For Folder hiện ra, bạn phải chỉ đến thư mục nào có chưa file txt nhé

 

[anpn79]

Thanks alot, mình sẽ nghiên cứu thêm.

Chúc bạn năm mới thành công !

 

[anpn79]

Cảm ơn bác ndu96081631 đã hỗ trợ lần trước.

Bước tiếp theo là tìm kiếm và thay thế nội dung. Mình mô tả sơ bộ như sau, bác xem giúp nhé.
- File đính kèm có 3 sheet chứa nội dung cần tìm kiếm và thay thế. có tạo Userform1 chứa all code với mục đích như sau:
- Bước 1: nhập địa chỉ IP1, IP2
- Bước 2: Command1 tìm và thay thế "neighbor IP1 encapsulation mpls " thành "no neighbor IP1 encapsulation mpls ", replace all --> mình đã làm được
- Bước 3: Command2 tìm "no neighbor IP1 encapsulation mpls " --> chèn thêm 1 dòng giống như vậy --> thay thế ngược lại "no neighbor IP1 encapsulation mpls " thành "neighbor IP2 encapsulation mpls " --> mình đã làm được nhưng hơi chuối và phải click nhiều lần, chưa thực hiện all được, và chưa thực hiện trên tất cả các sheet được

Bác giúp mình thực hiện và có thể tối ưu được thì càng tốt. Thanks alot.

P/S: Bác có nhận học viên kèm trong thời gian ngắn không vậy , mình mới nghiên cứu món này được 2 tháng, thấy hay và có thể áp dụng được, thấy thú vị định tìm thầy học.

 

[ndu96081631]

mình đã làm được nhưng hơi chuối và phải click nhiều lần, chưa thực hiện all được, và chưa thực hiện trên tất cả các sheet được
.

- Bấm Alt + F11 mở cửa sổ VBA
- Xong, bấm F1 mở Help.
- Trong cửa sổ Help, gõ từ khóa FindNext rồi Enter
Sẽ có ngay hướng dẫn + một ví dụ cụ thể để bạn giải quyết bài toán tìm kiếm và thay thế

 

[duongrcfee]

Bạn có thể cho mình hỏi làm thế nào để khi đưa dữ liệu txt vào trong các sheet thì tách thành cột nhé!

 

[dosontung86]

Bạn có thể cho mình hỏi làm thế nào để khi đưa dữ liệu txt vào trong các sheet thì tách thành cột nhé!

Em cũng có câu hỏi như trên ạ. Mong các bác hướng dẫn