Gộp nhiều file thành file tổng và chèn thêm 1 cột là tên file ! (1 người xem)

[Loan Châu]

Kính chào quý anh, chị !
Hiện em có một khó khăn trong công việc, em rất mong nhận được sự giúp đỡ của quý anh chị !
Khó khăn của em đó là em có rất nhiều file có cấu trúc giống nhau em muốn gộp thành file tổng ( cái này em tìm trên diễn đàn đã có code gộp tổng) nhưng cái khó là khi gộp thành file tổng em muốn biết là dữ liệu thuộc file nào. Vì thế em muốn khi gộp tổng thì chèn them 01 cột nữa là lấy luôn tên file.
em đã nêu cụ thể trong file đính kèm. em rất mong quý anh chị giúp đỡ cho em với ạ !
em cảm ơn quý anh chị nhiều nhiều trước !
Trân trọng,
Loan Châu

 

[Loan Châu]

Dạ tại em tưởng diễn đàn này chỉ có chức năng tổng hợp dữ liệu từ file Excel thôi, nên em mới cố gắng import mấy trăm tét files vào mấy trăm files excel ạ.

Chào bạn AutoReply,
Mình không hề không hề có ý đó, mình mới vào làm các anh nhờ nhập thì mình nhập nhưng thấy làm thủ công vậy vừa mất công mà lại dễ nhầm nữa nên mình lên diễn dàn nhờ giúp đỡ cho khó khan của mình. Chứ mình lên đây thấy thành viên trên diễn đàn tuyệt vời tuyệt vời quá. Tuyệt vời nhất là giúp đỡ nhiệt tình, hướng dẫn vui vẽ và kiên nhẫn giải thích nhiều câu hỏi của các bạn mới ( trong đó có mình vì nhiều khi cách diễn đạt câu hỏi của mình cứ long vòng).

 

[VetMini]

Em gộp cả ngày mõi tay quá nên mới mạo muội lên diên đàn nhờ các anh các chị và các bạn biết viết code giúp em. Còn mấy cái này 1 cái script (VBScript, JavaScript, hoặc Powershell) để em tìm hiểu đã, giờ đọc bài viết của anh em mới biết. hihi. anh thấy em quê không ?

Chả có gì quê cả. Mà có quê cũng chẳng ai nghĩ gì xấu cả. Tôi lên thành thị vì miếng cơm manh áo chứ có tiền tôi về quê ở cho khoẻ.

Cần thì nhờ giúp, chưa biết thì hỏi, tất cả chỉ là chuyện bình thường.

 

[AutoReply]

Chào bạn AutoReply,
Mình không hề không hề có ý đó, mình mới vào làm các anh nhờ nhập thì mình nhập nhưng thấy làm thủ công vậy vừa mất công mà lại dễ nhầm nữa nên mình lên diễn dàn nhờ giúp đỡ cho khó khan của mình. Chứ mình lên đây thấy thành viên trên diễn đàn tuyệt vời tuyệt vời quá. Tuyệt vời nhất là giúp đỡ nhiệt tình, hướng dẫn vui vẽ và kiên nhẫn giải thích nhiều câu hỏi của các bạn mới ( trong đó có mình vì nhiều khi cách diễn đạt câu hỏi của mình cứ long vòng).

Hỏi lòng vòng cũng không sao đâu bạn. Chỉ cần nhìn hình chỗ tài khoản của bạn thì mấy anh mạnh mẽ ở trên trả lời được hết.

 

[VetMini]

Hỏi lòng vòng cũng không sao đâu bạn. Chỉ cần nhìn hình chỗ tài khoản của bạn thì mấy anh mạnh mẽ ở trên trả lời được hết.

Hình của bạn trả lời còn mạnh hơn. Chỉ phải cái là mấy anh bị móc vài lần rách mép hết rồi, khổng ai dám cắn câu nữa.

 

[befaint]

khổng ai dám cắn câu nữa

Hem phải hem dám cắn nữa mà tại mép rách tươm rồi nên hem mắc câu được ạ.

 

[Loan Châu]

Public Sub ImportTxt_ToExcel()
Dim Fso As Object, TextSource As Object, TotalLines, Item, Tmp
Dim K As Long, I As Long, sArr(1 To 500000, 1 To 4)

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 = LBound(TotalLines) To UBound(TotalLines)
            If Len(TotalLines(I)) Then
            Tmp = Split(TotalLines(I), vbTab)
                K = K + 1
                sArr(K, 1) = Tmp(0)
                sArr(K, 2) = Val(Tmp(1))
                sArr(K, 3) = Val(Tmp(2))
                sArr(K, 4) = Fso.GetBaseName(Item)
            End If
        Next
Next
End With
If K Then
    Range("A1").CurrentRegion.Offset(1).ClearContents
    Range("A2").Resize(K, 4).Value = sArr
End If
MsgBox "Done!"
Application.ScreenUpdating = True
End Sub

Châu cảm ơn bạn Hpkhuong nhiều nhé ! Code của bạn rất tuyệt vời, chúc bạn nhiều sức khỏe !

 

[Loan Châu]

Chả có gì quê cả. Mà có quê cũng chẳng ai nghĩ gì xấu cả. Tôi lên thành thị vì miếng cơm manh áo chứ có tiền tôi về quê ở cho khoẻ.

Cần thì nhờ giúp, chưa biết thì hỏi, tất cả chỉ là chuyện bình thường.

em cảm ơn anh VetMini trước nhé! Sau này có gì vướng em sẽ lại làm phiền làm phiền các anh chị nhé!

 

[Loan Châu]

Hỏi lòng vòng cũng không sao đâu bạn. Chỉ cần nhìn hình chỗ tài khoản của bạn thì mấy anh mạnh mẽ ở trên trả lời được hết.

hihi, bạn Autoreply vui tính vui tính quá !

 

[Loan Châu]

Hem phải hem dám cắn nữa mà tại mép rách tươm rồi nên hem mắc câu được ạ.

hihi, anh Befain vui tính quá!

 

[chisinhvnn]

hihi, anh Befain vui tính quá!

Bới gạo vào TP huế gặp anh Việt Hoài, anh truyền ít chiêu đi Loan Châu.

 

[thetrungkien]

Public Sub ImportTxt_ToExcel()
Dim Fso As Object, TextSource As Object, TotalLines, Item, Tmp
Dim K As Long, I As Long, sArr(1 To 500000, 1 To 4)

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 = LBound(TotalLines) To UBound(TotalLines)
            If Len(TotalLines(I)) Then
            Tmp = Split(TotalLines(I), vbTab)
                K = K + 1
                sArr(K, 1) = Tmp(0)
                sArr(K, 2) = Val(Tmp(1))
                sArr(K, 3) = Val(Tmp(2))
                sArr(K, 4) = Fso.GetBaseName(Item)
            End If
        Next
Next
End With
If K Then
    Range("A1").CurrentRegion.Offset(1).ClearContents
    Range("A2").Resize(K, 4).Value = sArr
End If
MsgBox "Done!"
Application.ScreenUpdating = True
End Sub

Code Bạn viết rất hay và chuyên nghiệp