Gộp nhiều file thành file tổng và chèn thêm 1 cột là tên file !

Liên hệ QC
Loan Châu

Loan Châu

Thành viên hoạt động
Tham gia
17/6/17
Bài viết
136
Được thích
39
Giới tính
Nữ
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
 

File đính kèm

  • Help.rar
    1.6 MB · Đọc: 71
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
VetMini đã viết:
Nếu con số tới mấy trăm mà bắt người ta làm bằng tay thì là do mấy thằng cha đó mắc bệnh sa đít (sadistic).
Cách làm đúng đắn là người làm chịu khó ghi luôn tên file thành 1 cột. Bạn chỉ việc dùng lệnh DOS để gộp các files lại thành 1 rồi import vào excel.
Nếu cơ quan bạn có một người làm mạng hoặc hệ thống thì nhờ ngừoi ta viết cho 1 cái script (VBScript, JavaScript, hoặc Powershell) tổng hợp files rồi bạn import.

Bài này dùng code như anh HLMT (bài #5) cũng được. Nhưng đó là giải pháp của dân chuyên nghiệp. Cái trách nhiệm gộp files đúng ra không nên gán cho ngừoi không biết code.
Nếu bạn phải lãnh trách nhiệm này thì nên đòi tăng lương. Công việc chuyển đổi dữ liệu (Data Migration) là công việc tương đối cao cấp.
Nhấp chuột vào đây để mở rộng...

Chào anh Vetmini !
Mấy anh ấy làm công trình, chắc không biết lập trình anh à chứ không có ý gì ý gì đâu anh. Các anh xuất từ phần mềm ra , em mới vào làm nên nhờ em gộp thành file Excel thôi.
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 ?
Em cảm ơn anh nhiều nhiều lời khuyên của anh Vetmini nhé!
 
Upvote 0
AutoReply đã viết:
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 ạ.
Nhấp chuột vào đây để mở rộng...
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).
 
Upvote 0
Loan Châu đã viết:
chào bạn Hpkhuong !
Mình cảm ơn nhã ý của bạn và sẽ rất biết ơn quý anh chị và các bạn giúp cho mình từ file TXT tổng hợp thành file Tổng excel có chèn thêm cột tên file.
Mình gởi kèm các file .TXT
Nhấp chuột vào đây để mở rộng...
Mã: 
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
 
Upvote 0
Loan Châu đã viết:
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 ?
Nhấp chuột vào đây để mở rộ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.
 
Upvote 0
Loan Châu đã viết:
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).
Nhấp chuột vào đây để mở rộ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.
 
Upvote 0
AutoReply đã viết:
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.
Nhấp chuột vào đây để mở rộng...

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.
 
Upvote 0
hpkhuong đã viết:
Mã: 
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
Nhấp chuột vào đây để mở rộng...
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 !
 
Upvote 0
VetMini đã viết:
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.
Nhấp chuột vào đây để mở rộ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é!
 
Upvote 0
hpkhuong đã viết:
Mã: 
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
Nhấp chuột vào đây để mở rộng...
Code Bạn viết rất hay và chuyên nghiệp
 
Upvote 0
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

HeSanbi
  • Question
Hàm UDF JoinCells: Tự động gộp chuỗi nhiều ô giữ định dạng trong Excel
    • Thích
    • Yêu thích
2
Trả lời
28
Đọc
9K
tamthat
T
phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
5
Đọc
93
Phuocam
Phuocam
O
Kết hợp hàm value
Trả lời
3
Đọc
77
Phuocam
Phuocam
ptm0412
Chi tiết cách dùng của 14 hàm mới trong Excel 365 (tháng 8/ 2022)
    • Thích
    • Yêu thích
    • Cảm ơn
2
Trả lời
20
Đọc
9K
nguyenthinhqn
N
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2 3 4
Trả lời
72
Đọc
1K
LuuAnh980
LuuAnh980
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