Gộp nhiều phai *.txt có định dang giống nhau vao một phai tổng.xls (1 người xem)

[van_k49]

Gộp nhiều phai *.txt có định dang giống nhau vào một phai tổng.xls

Nhờ các anh chị giúp em. em có rất nhiều phai *.txt có định dang giống nhau giờ em muốn chuyển các phai đó sang một phai .xls để tổng hợp. có ai lam được thì giúp em với nhé em đang cần gấp. em có gởi phai đính kèm rồi nhé

 

[ndu96081631]

Nhờ các anh chị giúp em. em có rất nhiều phai *.txt có định dang giống nhau giờ em muốn chuyển các phai đó sang một phai .xls để tổng hợp. có ai lam được thì giúp em với nhé em đang cần gấp. em có gởi phai đính kèm rồi nhé

Excel có công cụ Import, bạn dùng nó để Import date từ text file cũng được vậy
Bạn có thể record macro quá trình làm bằng tay để có code, từ đó thực thi việc import 1 cách tự động
Ví dụ tôi record macro rồi sửa lại code thế này:

Sub Macro1()
  Dim wkb As Workbook, wks As Worksheet, Target As Range
  Dim txtFile As String, aFiles, fleItem
  aFiles = Array("dc1", "dc13", "dc31", "dc32")
  Set wkb = ThisWorkbook: Set wks = wkb.ActiveSheet
  For Each fleItem In aFiles
    txtFile = wkb.Path & "\" & CStr(fleItem) & ".txt"
    Set Target = wks.Range("B60000").End(xlUp).Offset(1, -1)
    With wks.QueryTables.Add("TEXT;" & txtFile, Target)
      .TextFileOtherDelimiter = "|"
      .Refresh BackgroundQuery:=False
    End With
  Next
End Sub

 

[van_k49]

Cảm ơn anh nhiều, em muốn hỏi thêm chút nữa là: em không muốn đánh số tờ dc1,dc2,.....dc100 vào trong code như thế thì lâu lắm, anh có thể giúp em chỉ cần chọn vào thư mục chứa các phai đó là nó khác load vào hết được không?
Thứ hai là: khi dữ liệu vào trong phai .xls rồi nhưng lại không dùng được các hàm công thức ví dụ như hàm sumif cho cột diện tích và loại đất, mặc dù em đã chuyển cột diện tích về dạng số rồi, nhờ anh giúp đỡ với

 

[ndu96081631]

Cảm ơn anh nhiều, em muốn hỏi thêm chút nữa là: em không muốn đánh số tờ dc1,dc2,.....dc100 vào trong code như thế thì lâu lắm, anh có thể giúp em chỉ cần chọn vào thư mục chứa các phai đó là nó khác load vào hết được không?

Đoạn này: aFiles = Array("dc1", "dc13", "dc31", "dc32") chỉ là ví dụ minh họa thôi.
Đương nhiên áp dụng vào thực tế ta sẽ có 1 đoạn code khác dùng để lấy list file trong thư mục. Ví dụ:

Function GetFilesList(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 GetFilesList = Split(tmp, vbCrLf)
      .Close
    End With
  End With
  Kill tmpFile
End Function

Khi ấy, áp dụng vào code sẽ là:
aFiles = GetFilesList(Thư mục chứa file txt, "*.txt", True)
Ví dụ:
aFiles = GetFilesList("D:\Bien tap", "*.txt", True)
Hoặc giả file Excel của bạn nằm cùng với thư mục chứa file txt thì:
aFiles = GetFilesList(ThisWorkbook.Path, "*.txt", True)
Khi ấy code sẽ sửa thành:

Sub Main()
  Dim wkb As Workbook, wks As Worksheet, Target As Range
  Dim txtFile As String, aFiles, fleItem
  Set wkb = ThisWorkbook: Set wks = wkb.ActiveSheet
 [COLOR=#ff0000] aFiles = GetFilesList(ThisWorkbook.Path, "*.txt", True)[/COLOR]
  If IsArray(aFiles) Then
    For Each fleItem In aFiles
     [COLOR=#ff0000] txtFile = CStr(fleItem)[/COLOR]
      Set Target = wks.Range("B60000").End(xlUp).Offset(1, -1)
      With wks.QueryTables.Add("TEXT;" & txtFile, Target)
        .TextFileOtherDelimiter = "|"
        .Refresh BackgroundQuery:=False
      End With
    Next
    MsgBox "Finish!"
  End If
End Sub

Những chổ màu đỏ là chổ sửa lại
---------------
Ngoài ra, bạn cũng có thể tạo 1 nút Browse cho phép người dùng tự mình chọn thư mục:

Sub Main()
  Dim wkb As Workbook, wks As Worksheet, Target As Range
  Dim txtFile As String, Folder, aFiles, fleItem
  Set wkb = ThisWorkbook: Set wks = wkb.ActiveSheet
  On Error Resume Next
  [COLOR=#ff0000]Folder = CreateObject("Shell.Application").BrowseForFolder(0, "", 1).Self.Path[/COLOR]
  If TypeName(Folder) <> "String" Then Exit Sub
  aFiles = GetFilesList(Folder, "*.txt", True)
  If IsArray(aFiles) Then
    For Each fleItem In aFiles
      txtFile = CStr(fleItem)
      Set Target = wks.Range("B60000").End(xlUp).Offset(1, -1)
      With wks.QueryTables.Add("TEXT;" & txtFile, Target)
        .TextFileOtherDelimiter = "|"
        .Refresh BackgroundQuery:=False
      End With
    Next
    MsgBox "Finish!"
  End If
End Sub

Chổ màu đỏ là để gọi hộp Browse Folder đấy
------------------------------

Thứ hai là: khi dữ liệu vào trong phai .xls rồi nhưng lại không dùng được các hàm công thức ví dụ như hàm sumif cho cột diện tích và loại đất, mặc dù em đã chuyển cột diện tích về dạng số rồi, nhờ anh giúp đỡ với

Việc import txt file vào Excel thì file text chứa cái gì nó sẽ import y chang thế. Trong file text của bạn, số được định dạng dấu thập phân là dấu chấm. Vậy để có thể tính toán được trong Excel, bạn phải xem lại Control Panel trên máy mình đang quy định dấu nào là dấu thập phân? Nếu không phải là dấu chấm thì hãy sửa lại
Nếu không muốn chỉnh Control Panel thì đương nhiên bạn phải tự chỉnh bằng tay trong bảng tính sao cho các số nhìn thấy thật sự trở thành number
Tôi không biết bạn chỉnh thế nào mà lại không dùng được với SUMIF. Nếu muốn biết chi tiết, bạn chỉnh xong, gửi lên đây tôi xem thử

 

[van_k49]

Anh xem hộ em, em gửi phai lên rồi

 

[ndu96081631]

Anh xem hộ em, em gửi phai lên rồi

Bạn đang dùng công thức:

=SUMIF($G5:$G24,[COLOR=#ff0000]"nhk"[/COLOR],$E5:$E24)

Hãy sửa thành:

=SUMIF($G5:$G24,[COLOR=#ff0000]"*nhk*"[/COLOR],$E5:$E24)

Nguyên nhân vì cột loại đất, giá trị trong cell có quá trời khoảng trắng trước chuổi (kiểm tra thử)

 

[baquang1984]

Thầy ndu96081631 cho em hỏi chút là trương chình của thầy khi tổng hợp các file .text vào file excel thì tất cả các tiêu đề của các file đều xuất hiện. Vậy em muốn là chỉ để tiêu đề của file đầu tiên có được không ạ và muốn sửa thì sửa thế nào ạ mong được thầy giúp đỡ ạ (VD file đính kèm em gửi là khi tổng hợp em chỉ cần để lại các dòng tiêu đề em bôi vàng còn các tiêu đề của các file text khác em bôi màu xanh thì không cần xuất hiện nữa ạ
Cảm ơn thầy ạ!

Đoạn này: aFiles = Array("dc1", "dc13", "dc31", "dc32") chỉ là ví dụ minh họa thôi.
Đương nhiên áp dụng vào thực tế ta sẽ có 1 đoạn code khác dùng để lấy list file trong thư mục. Ví dụ:

Function GetFilesList(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 GetFilesList = Split(tmp, vbCrLf)
      .Close
    End With
  End With
  Kill tmpFile
End Function

Khi ấy, áp dụng vào code sẽ là:
aFiles = GetFilesList(Thư mục chứa file txt, "*.txt", True)
Ví dụ:
aFiles = GetFilesList("D:\Bien tap", "*.txt", True)
Hoặc giả file Excel của bạn nằm cùng với thư mục chứa file txt thì:
aFiles = GetFilesList(ThisWorkbook.Path, "*.txt", True)
Khi ấy code sẽ sửa thành:

Sub Main()
  Dim wkb As Workbook, wks As Worksheet, Target As Range
  Dim txtFile As String, aFiles, fleItem
  Set wkb = ThisWorkbook: Set wks = wkb.ActiveSheet
 [COLOR=#ff0000] aFiles = GetFilesList(ThisWorkbook.Path, "*.txt", True)[/COLOR]
  If IsArray(aFiles) Then
    For Each fleItem In aFiles
     [COLOR=#ff0000] txtFile = CStr(fleItem)[/COLOR]
      Set Target = wks.Range("B60000").End(xlUp).Offset(1, -1)
      With wks.QueryTables.Add("TEXT;" & txtFile, Target)
        .TextFileOtherDelimiter = "|"
        .Refresh BackgroundQuery:=False
      End With
    Next
    MsgBox "Finish!"
  End If
End Sub

Những chổ màu đỏ là chổ sửa lại
---------------
Ngoài ra, bạn cũng có thể tạo 1 nút Browse cho phép người dùng tự mình chọn thư mục:

Sub Main()
  Dim wkb As Workbook, wks As Worksheet, Target As Range
  Dim txtFile As String, Folder, aFiles, fleItem
  Set wkb = ThisWorkbook: Set wks = wkb.ActiveSheet
  On Error Resume Next
  [COLOR=#ff0000]Folder = CreateObject("Shell.Application").BrowseForFolder(0, "", 1).Self.Path[/COLOR]
  If TypeName(Folder) <> "String" Then Exit Sub
  aFiles = GetFilesList(Folder, "*.txt", True)
  If IsArray(aFiles) Then
    For Each fleItem In aFiles
      txtFile = CStr(fleItem)
      Set Target = wks.Range("B60000").End(xlUp).Offset(1, -1)
      With wks.QueryTables.Add("TEXT;" & txtFile, Target)
        .TextFileOtherDelimiter = "|"
        .Refresh BackgroundQuery:=False
      End With
    Next
    MsgBox "Finish!"
  End If
End Sub

Chổ màu đỏ là để gọi hộp Browse Folder đấy
------------------------------