[Cần giúp đỡ] Tổng hợp nhiều sheet từ nhiều file thành nhiều sheet trong một file

Liên hệ QC
HHN

HHN

Thành viên chính thức
Tham gia
26/1/07
Bài viết
50
Được thích
69
Nghề nghiệp
Lái xe
Xin chào toàn thể ACE GPE, nhân dịp Giáng Sinh HHN xin gửi lời chúc đến toàn thể ACE GPE sức khỏe và thành công J
Rồi em xin nhờ vả một việc như sau ạ:
Em muốn tổng hợp nhiều sheet từ nhiều file thành nhiều sheet trong một file cụ thể như sau:
(Bài của em gần giống bài này, nhưng yêu cầu cao hơn chút :D )
Em có file đính kèm và yêu cầu là:
Tổng hợp các sheet từ file báo cáo riêng lẻ của nhân viên về file tổng hợp
Với điều kiện là:
Sheet T1, Sheet T2, Sheet…. trong các file của nhân viên về sheet T1, Sheet T2, sheet… của file tổng hợp. cấu trúc các file là giống nhau.
Với điều kiện là dữ liệu phải được trộn đều, ví dụ: các sheet T1 của tất cả các nhân viên đang nhập dữ liệu của từng ngày trong tháng 01, thì sheet T1 trong file tổng hợp sẽ tổng hợp toàn bộ các sheet của nhân viên về, nhưng sắp xếp theo thời gian của nhân viên đó nhập vào, chứ không phải tổng hợp theo kiểu là nhặt lần lượt hết sheet T1 của nhân viên này đến sheet T1 nhân viên khác, không biết em nói thế các bác có hiểu không nhể.
Trân trọng cảm ơn các bác đã đọc bài J
 

File đính kèm

  • BCGD2103-4.rar
    96.2 KB · Đọc: 56
Lần chỉnh sửa cuối:
hhn đã viết:
Xin chào toàn thể ACE GPE, nhân dịp Giáng Sinh HHN xin gửi lời chúc đến toàn thể ACE GPE sức khỏe và thành công J
Rồi em xin nhờ vả một việc như sau ạ:
Em muốn tổng hợp nhiều sheet từ nhiều file thành nhiều sheet trong một file cụ thể như sau:
(Bài của em gần giống bài này, nhưng yêu cầu cao hơn chút :D )
Em có file đính kèm và yêu cầu là:
Tổng hợp các sheet từ file báo cáo riêng lẻ của nhân viên về file tổng hợp
Với điều kiện là:
Sheet T1, Sheet T2, Sheet…. trong các file của nhân viên về sheet T1, Sheet T2, sheet… của file tổng hợp. cấu trúc các file là giống nhau.
Với điều kiện là dữ liệu phải được trộn đều, ví dụ: các sheet T1 của tất cả các nhân viên đang nhập dữ liệu của từng ngày trong tháng 01, thì sheet T1 trong file tổng hợp sẽ tổng hợp toàn bộ các sheet của nhân viên về, nhưng sắp xếp theo thời gian của nhân viên đó nhập vào, chứ không phải tổng hợp theo kiểu là nhặt lần lượt hết sheet T1 của nhân viên này đến sheet T1 nhân viên khác, không biết em nói thế các bác có hiểu không nhể.
Trân trọng cảm ơn các bác đã đọc bài J
Nhấp chuột vào đây để mở rộng...
Nếu là tôi thì tôi sẽ làm thế này.
1. Hỏi bài này trong mục lập trình
2. Tất cả các tên sheet sẽ đặt tên không có dấu tiếng việt. Điều này ảnh hưởng rất nhiều khi viết code
3. Chỉ cần đính kèm 3 file là đủ
4. Trong các file sẽ có dữ liệu mẫu ( file của tác giả trống trơn, ai thích làm thì tự điền dữ liệu vào nhé)
5. Trong file tổng hợp sẽ cho kết quả tạm để minh họa điều mình cần. Viết nhiều nhưng chưa chắc ai hiểu.
Bài này đơn giản nhưng cuối năm rồi gặp nhiều bài thế này quá nên nản. Chắc mình già rồi nên khó tính.
 
quanghai1969 đã viết:
Nếu là tôi thì tôi sẽ làm thế này.
1. Hỏi bài này trong mục lập trình
2. Tất cả các tên sheet sẽ đặt tên không có dấu tiếng việt. Điều này ảnh hưởng rất nhiều khi viết code
3. Chỉ cần đính kèm 3 file là đủ
4. Trong các file sẽ có dữ liệu mẫu ( file của tác giả trống trơn, ai thích làm thì tự điền dữ liệu vào nhé)
5. Trong file tổng hợp sẽ cho kết quả tạm để minh họa điều mình cần. Viết nhiều nhưng chưa chắc ai hiểu.
Bài này đơn giản nhưng cuối năm rồi gặp nhiều bài thế này quá nên nản. Chắc mình già rồi nên khó tính.
Nhấp chuột vào đây để mở rộng...
Vâng em cảm ơn bác rất nhiều ạ, em đã them nội dung và minh họa trong file, bác rảnh thì giúp em với :), Mod nào chuyển giúp em về đúng BOX với :)
 
quanghai1969 đã viết:
Nếu là tôi thì tôi sẽ làm thế này.
1. Hỏi bài này trong mục lập trình
2. Tất cả các tên sheet sẽ đặt tên không có dấu tiếng việt. Điều này ảnh hưởng rất nhiều khi viết code
3. Chỉ cần đính kèm 3 file là đủ
4. Trong các file sẽ có dữ liệu mẫu ( file của tác giả trống trơn, ai thích làm thì tự điền dữ liệu vào nhé)
5. Trong file tổng hợp sẽ cho kết quả tạm để minh họa điều mình cần. Viết nhiều nhưng chưa chắc ai hiểu.
Bài này đơn giản nhưng cuối năm rồi gặp nhiều bài thế này quá nên nản. Chắc mình già rồi nên khó tính.
Nhấp chuột vào đây để mở rộng...


anh Hải ơi, cái này viết code gộp sheet là ổn phải không ạk? Xong nhớ share cho em nha....
 
hhn đã viết:
Bài của em chắc là phức tạp hơn bác ạ :)
Nhấp chuột vào đây để mở rộng...
Viết code cho bài này chắc không khó khăn gì, nhưng hiện tại các file của bạn không biết bị gì mà mình tải file về mở lên thì gặp lỗi. Chỉnh sửa xong lưu lại thì luôn tạo ra 1 file backup... Không biết có ai thử file này chưa và có bị giống mình không.
 
quanghai1969 đã viết:
Viết code cho bài này chắc không khó khăn gì, nhưng hiện tại các file của bạn không biết bị gì mà mình tải file về mở lên thì gặp lỗi. Chỉnh sửa xong lưu lại thì luôn tạo ra 1 file backup... Không biết có ai thử file này chưa và có bị giống mình không.
Nhấp chuột vào đây để mở rộng...
Em mở file cũ thì vẫn bình thường, nhưng khi tải file nén này về thì cũng bị ra thêm file backup, em nén lại những file cũ trong máy em, các bác tải về thử xem còn bị vậy nữa không nhé.
 
hhn đã viết:
Em mở file cũ thì vẫn bình thường, nhưng khi tải file nén này về thì cũng bị ra thêm file backup, em nén lại những file cũ trong máy em, các bác tải về thử xem còn bị vậy nữa không nhé.
Nhấp chuột vào đây để mở rộng...
Vẫn bị y như vậy. Hình như office của bạn bị lỗi hay sao ấy.
 
quanghai1969 đã viết:
Viết code cho bài này chắc không khó khăn gì, nhưng hiện tại các file của bạn không biết bị gì mà mình tải file về mở lên thì gặp lỗi. Chỉnh sửa xong lưu lại thì luôn tạo ra 1 file backup... Không biết có ai thử file này chưa và có bị giống mình không.
Nhấp chuột vào đây để mở rộng...

Đó là chức năng tự động tạo Backup file thôi
- Bấm F12 để Save As
- Bấm nút Tools, chọn General Options
- Bỏ check mục "Always create backup"

Capture.JPG

Xong!
 
quanghai1969 đã viết:
Vẫn bị y như vậy. Hình như office của bạn bị lỗi hay sao ấy.
Nhấp chuột vào đây để mở rộng...
Lần này em nén file từ máy tạo ra file này rồi, các bác xem còn bị không ạ, em mở trên máy em vẫn bình thường, nhưng sang máy khác mở cũng bị backup, file đính kèm lần này em đã thử trên 2 máy đều không bị.
 

File đính kèm

  • BCGD2103-4.rar
    96.2 KB · Đọc: 77
hhn đã viết:
Lần này em nén file từ máy tạo ra file này rồi, các bác xem còn bị không ạ, em mở trên máy em vẫn bình thường, nhưng sang máy khác mở cũng bị backup, file đính kèm lần này em đã thử trên 2 máy đều không bị.
Nhấp chuột vào đây để mở rộng...

Giải nén vào thư mục chứa các file con và chạy code.

Trong code có mượn hàm GetListFile của anh NDU để hỗ trợ lấy tên file
 

File đính kèm

  • BCGD 2013 - Tong hop.rar
    41 KB · Đọc: 51
Lần chỉnh sửa cuối:
quanghai1969 đã viết:
Giải nén vào thư mục chứa các file con và chạy code.

Trong code có mượn hàm GetListFile của anh NDU để hỗ trợ lấy tên file
Nhấp chuột vào đây để mở rộng...

Bài này tôi thiên về ADO hơn (vì CSDL của tác giả rất chuẩn)
Ta viết thêm 1 Sub
Mã: 
Sub GetData(ByVal FileName As Variant, ByVal SheetName As String, _
            ByVal RangeAddress As String, ByVal Target As Range, _
            ByVal HasTitle As Boolean, ByVal UseTitle As Boolean)
            
  Dim rsCon As Object, rsData As Object
  Dim szConnect As String, szSQL As String
  Dim lCount As Long
  If Val(Application.Version) < 12 Then
    szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 8.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  Else
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 12.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  End If
  If SheetName = "" Then
    szSQL = "SELECT * FROM " & RangeAddress & ";"
  Else
    If RangeAddress = "" Then
      szSQL = "SELECT * FROM [" & SheetName & "$]"
    Else
      szSQL = "SELECT * FROM [" & SheetName & "$" & RangeAddress$ & "];"
    End If
  End If
  
  On Error GoTo ErrAlert

  Set rsCon = CreateObject("ADODB.Connection")
  Set rsData = CreateObject("ADODB.Recordset")

  rsCon.Open szConnect
  rsData.Open szSQL, rsCon, 0, 1, 1
   
  If Not rsData.EOF Then
    If HasTitle = False Then
      Target.Cells(1, 1).CopyFromRecordset rsData
    Else
      If UseTitle Then
        For lCount = 0 To rsData.Fields.Count - 1
          Target.Cells(1, 1 + lCount).Value = rsData.Fields(lCount).Name
        Next
        Target.Cells(2, 1).CopyFromRecordset rsData
      Else
        Target.Cells(1, 1).CopyFromRecordset rsData
      End If
    End If
  Else
    MsgBox "No records returned from : " & FileName, vbCritical
  End If
  rsData.Close: Set rsData = Nothing
  rsCon.Close: Set rsCon = Nothing
  Exit Sub
ErrAlert:
  MsgBox "The file name, Sheet name or Range is invalid of : " & FileName, _
           vbExclamation, "Error"
End Sub
Giờ sửa code của Quang Hải lại tí:
Mã: 
Sub quanghai()
  Dim arr, wkb As Workbook, aWks()
  Dim i As Long, j As Long
  Dim fleName As String, SheetName As String, sAddress As String, Target As Range
  Application.ScreenUpdating = False
  Set wkb = ThisWorkbook
  aWks = Array("T1", "T2", "T3", "T4", "T5", "T6", "T7", "T8", "T9", "T10", "T11", "T12")
  sAddress = "B6:O1000"
  For j = 0 To UBound(aWks)
    wkb.Sheets(aWks(j)).Range("B6:Q10000").ClearContents
  Next
  arr = GetListFile(ThisWorkbook.Path, "*.xls?", True)
  For i = 0 To UBound(arr)
    If arr(i) <> ThisWorkbook.FullName Then
      fleName = arr(i)
      For j = 0 To UBound(aWks)
        SheetName = aWks(j)
        With wkb.Sheets(SheetName)
          Set Target = .Range("B60000").End(xlUp).Offset(1)
          GetData fleName, SheetName, sAddress, Target, False, False
        End With
      Next
    End If
  Next
  For j = 0 To UBound(aWks)
    With wkb.Sheets(aWks(j))
      .Range(.[B6], .[B65536].End(3)).Resize(, 16).Sort .[C5]
    End With
  Next
  MsgBox "Done"
  Application.ScreenUpdating = True
End Sub
----------------
Có thời gian rảnh (đầu óc sáng lên) tôi nhất định sẽ sửa Sub GetData thành 1 Function để kết quả trả về là 1 mảng
 

File đính kèm

  • BCGD2103-4.rar
    112.5 KB · Đọc: 87
Lần chỉnh sửa cuối:
Em cảm ơn hai bác quanghai1969 và ndu96081631 rất nhiều ạ, em về chạy thử, thắc mắc gì em sẽ hỏi tiếp :) các bác nhiệt tình quá :)
 
Em test rồi mọi vấn đề đều đáp ứng nhu cầu của em rồi, nhưng em phiền các bác thêm chút nữa. em muốn sheet "Tong hop" của file nhân viên cũng được tổng hợp từ T1 đến t12, (như sheet "Tong hop" của file Tổng Hợp) và trong file Tổng Hợp các sheet còn lại như " VPKV" ; "GDBT Ho"; "Nho GDBT Ho" cũng lấy dữ liệu từ các sheet tương ứng trong file nhân viên ạ.
 
hhn đã viết:
em muốn sheet "Tong hop" của file nhân viên cũng được tổng hợp từ T1 đến t12, (như sheet "Tong hop" của file Tổng Hợp)
Nhấp chuột vào đây để mở rộng...
Trong file TONGHOP, tại sheet TONGHOP đang dùng sự kiện Worksheet_Activate để chạy code. Vậy bạn copy code này, cộng với Sub TọngHop và Paste vào các file khác là được rồi (paste đúng vị trí)
-----------------------------------
hhn đã viết:
trong file Tổng Hợp các sheet còn lại như " VPKV" ; "GDBT Ho"; "Nho GDBT Ho" cũng lấy dữ liệu từ các sheet tương ứng trong file nhân viên ạ.
Nhấp chuột vào đây để mở rộng...
Trong code có đoạn:
Mã: 
aWks = Array("T1", "T2", "T3", "T4", "T5", "T6", "T7", "T8", "T9", "T10", "T11", "T12")
Sửa thành:
Mã: 
aWks = Array("T1", "T2", "T3", "T4", "T5", "T6", "T7", "T8", "T9",  "T10", "T11", "T12", [COLOR=#ff0000]"VPKV", "GDBT ho", "Nho GDBT Ho"[/COLOR])
-----------------------------------
Code đã có sẵn, sao bạn không tự "vọc"
 
ndu96081631 đã viết:
Trong file TONGHOP, tại sheet TONGHOP đang dùng sự kiện Worksheet_Activate để chạy code. Vậy bạn copy code này, cộng với Sub TọngHop và Paste vào các file khác là được rồi (paste đúng vị trí)
-----------------------------------

Trong code có đoạn:
Mã: 
aWks = Array("T1", "T2", "T3", "T4", "T5", "T6", "T7", "T8", "T9", "T10", "T11", "T12")
Sửa thành:
Mã: 
aWks = Array("T1", "T2", "T3", "T4", "T5", "T6", "T7", "T8", "T9",  "T10", "T11", "T12", [COLOR=#ff0000]"VPKV", "GDBT ho", "Nho GDBT Ho"[/COLOR])
-----------------------------------
Code đã có sẵn, sao bạn không tự "vọc"
Nhấp chuột vào đây để mở rộng...
Em vọc rồi nhưng nó bị loan ạ :D em cũng đã copy đoạn code nhưng nó không chạy, giờ em copy lại xem thế nào.
 
Lần chỉnh sửa cuối:
Cám ơn các bác, em làm được rồi ạ. :)
 
hhn đã viết:
Cám ơn các bác, em làm được rồi ạ. :)
Nhấp chuột vào đây để mở rộng...

Như đã hứa, tôi chuyển Sub GetData thành Function luôn
Mã: 
Function GetData(ByVal FileName As String, ByVal SheetName As String, ByVal RangeAddress As String, _
            ByVal HasTitle As Boolean, ByVal UseTitle As Boolean)
            
  Dim rsCon As Object, rsData As Object, tmpArr, Arr()
  Dim szConnect As String, szSQL As String
  Dim lCount As Long, lR As Long, lC As Long
  If Val(Application.Version) < 12 Then
    szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 8.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  Else
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 12.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  End If
  If SheetName = "" Then
    szSQL = "SELECT * FROM " & RangeAddress & ";"
  Else
    If RangeAddress = "" Then
      szSQL = "SELECT * FROM [" & SheetName & "$]"
    Else
      szSQL = "SELECT * FROM [" & SheetName & "$" & RangeAddress$ & "];"
    End If
  End If

  Set rsCon = CreateObject("ADODB.Connection")
  Set rsData = CreateObject("ADODB.Recordset")
  
  rsCon.Open szConnect
  rsData.Open szSQL, rsCon, 0, 1, 1
  tmpArr = rsData.GetRows
  ReDim Arr(UBound(tmpArr, 2) - UseTitle, UBound(tmpArr, 1) + 1)
  If UseTitle Then
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      Arr(0, lC) = rsData.Fields(lC).Name
    Next
  End If
  For lR = LBound(tmpArr, 2) To UBound(tmpArr, 2)
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      Arr(lR - UseTitle, lC) = tmpArr(lC, lR)
    Next
  Next
  rsData.Close: Set rsData = Nothing
  rsCon.Close: Set rsCon = Nothing
  GetData = Arr
End Function
và code quanghai sửa thành:
Mã: 
Sub quanghai()
  Dim Arr, wkb As Workbook, aWks(), aData
  Dim t As Double
  Dim i As Long, j As Long
  Dim fleName As String, SheetName As String, sAddress As String, Target As Range
  t = Timer
  Application.ScreenUpdating = False
  Set wkb = ThisWorkbook
  aWks = Array("T1", "T2", "T3", "T4", "T5", "T6", "T7", "T8", "T9", "T10", "T11", "T12")
  sAddress = "B6:O1000"
  For j = 0 To UBound(aWks)
    wkb.Sheets(aWks(j)).Range("B6:Q10000").ClearContents
  Next
  Arr = GetListFile(ThisWorkbook.Path, "*.xls?", True)
  For i = 0 To UBound(Arr)
    If Arr(i) <> ThisWorkbook.FullName Then
      fleName = Arr(i)
      For j = 0 To UBound(aWks)
        SheetName = aWks(j)
        With wkb.Sheets(SheetName)
          aData = GetData(fleName, SheetName, sAddress, False, False)
          Set Target = .Range("B60000").End(xlUp).Offset(1)
          Target.Resize(UBound(aData, 1) + 1, UBound(aData, 2) + 1).Value = aData
        End With
      Next
    End If
  Next
  Application.ScreenUpdating = True
  MsgBox "Done", , Format(Timer - t, "0.000")
End Sub
------------------
Nói thêm về hàm GetData
- Hàm có cú pháp GetData(Tên File, Tên Sheet, Địa chỉ vùng dạng chuổi, Dữ liệu có tiêu đề không?, Có lấy luôn tiêu đề không?)
Ví dụ Arr = GetData("C:\A.xls", "Sheet1", "A1:D10", True, False) có nghĩa là lấy dữ liệu từ vùng A1:D10 của Sheet1 và của file C:\A.xls (dữ liệu này có Title nhưng ta không lấy Title)
- Hai đối số HasTitle và UseTitle có nghĩa là: Ta tự xác định xem vùng dữ liệu có bao gồm Tiêu đề hay không đồng thời khi lấy dữ liệu này ta có lấy luôn Tiêu đề không
- Tên file bắt buộc phải có nhưng Tên Sheet và địa chỉ vùng không cần phải có
- Nếu ta không nói gì đến tên sheet (tức Tên Sheet = "") đồng nghĩa ta muốn lấy dữ liệu tại sheet đầu
- Nếu ta không nói gì đến địa chỉ vùng (tức địa chỉ = "") đồng nghĩa ta muốn lấy toàn bộ những gì đang có trên sheet
------------------
Với hàm này, ta có thể lấy dữ liệu từ file đang đóng cho vào bất cứ đâu ta thích (vào cell hoặc vào UserForm chẳng hạn)
 
Lần chỉnh sửa cuối:
ndu96081631 đã viết:
Như đã hứa, tôi chuyển Sub GetData thành Function luôn
Mã: 
Function GetData(ByVal FileName As String, ByVal SheetName As String, ByVal RangeAddress As String, _
            ByVal HasTitle As Boolean, ByVal UseTitle As Boolean)
            
  Dim rsCon As Object, rsData As Object, tmpArr, Arr()
  Dim szConnect As String, szSQL As String
  Dim lCount As Long, lR As Long, lC As Long
  If Val(Application.Version) < 12 Then
    szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 8.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  Else
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 12.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
  End If
  If SheetName = "" Then
    szSQL = "SELECT * FROM " & RangeAddress & ";"
  Else
    If RangeAddress = "" Then
      szSQL = "SELECT * FROM [" & SheetName & "$]"
    Else
      szSQL = "SELECT * FROM [" & SheetName & "$" & RangeAddress$ & "];"
    End If
  End If

  Set rsCon = CreateObject("ADODB.Connection")
  Set rsData = CreateObject("ADODB.Recordset")
  
  rsCon.Open szConnect
  rsData.Open szSQL, rsCon, 0, 1, 1
  tmpArr = rsData.GetRows
  ReDim Arr(UBound(tmpArr, 2) - UseTitle, UBound(tmpArr, 1) + 1)
  If UseTitle Then
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      Arr(0, lC) = rsData.Fields(lC).Name
    Next
  End If
  For lR = LBound(tmpArr, 2) To UBound(tmpArr, 2)
    For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
      Arr(lR - UseTitle, lC) = tmpArr(lC, lR)
    Next
  Next
  rsData.Close: Set rsData = Nothing
  rsCon.Close: Set rsCon = Nothing
  GetData = Arr
End Function
và code quanghai sửa thành:
Mã: 
Sub quanghai()
  Dim Arr, wkb As Workbook, aWks(), aData
  Dim t As Double
  Dim i As Long, j As Long
  Dim fleName As String, SheetName As String, sAddress As String, Target As Range
  t = Timer
  Application.ScreenUpdating = False
  Set wkb = ThisWorkbook
  aWks = Array("T1", "T2", "T3", "T4", "T5", "T6", "T7", "T8", "T9", "T10", "T11", "T12")
  sAddress = "B6:O1000"
  For j = 0 To UBound(aWks)
    wkb.Sheets(aWks(j)).Range("B6:Q10000").ClearContents
  Next
  Arr = GetListFile(ThisWorkbook.Path, "*.xls?", True)
  For i = 0 To UBound(Arr)
    If Arr(i) <> ThisWorkbook.FullName Then
      fleName = Arr(i)
      For j = 0 To UBound(aWks)
        SheetName = aWks(j)
        With wkb.Sheets(SheetName)
          aData = GetData(fleName, SheetName, sAddress, False, False)
          Set Target = .Range("B60000").End(xlUp).Offset(1)
          Target.Resize(UBound(aData, 1) + 1, UBound(aData, 2) + 1).Value = aData
        End With
      Next
    End If
  Next
  Application.ScreenUpdating = True
  MsgBox "Done", , Format(Timer - t, "0.000")
End Sub
------------------
Nói thêm về hàm GetData
- Hàm có cú pháp GetData(Tên File, Tên Sheet, Địa chỉ vùng dạng chuổi, Dữ liệu có tiêu đề không?, Có lấy luôn tiêu đề không?)
Ví dụ Arr = GetData("C:\A.xls", "Sheet1", "A1:D10", True, False) có nghĩa là lấy dữ liệu từ vùng A1:D10 của Sheet1 và của file C:\A.xls (dữ liệu này có Title nhưng ta không lấy Title)
- Hai đối số HasTitle và UseTitle có nghĩa là: Ta tự xác định xem vùng dữ liệu có bao gồm Tiêu đề hay không đồng thời khi lấy dữ liệu này ta có lấy luôn Tiêu đề không
- Tên file bắt buộc phải có nhưng Tên Sheet và địa chỉ vùng không cần phải có
- Nếu ta không nói gì đến tên sheet (tức Tên Sheet = "") đồng nghĩa ta muốn lấy dữ liệu tại sheet đầu
- Nếu ta không nói gì đến địa chỉ vùng (tức địa chỉ = "") đồng nghĩa ta muốn lấy toàn bộ những gì đang có trên sheet
------------------
Với hàm này, ta có thể lấy dữ liệu từ file đang đóng cho vào bất cứ đâu ta thích (vào cell hoặc vào UserForm chẳng hạn)
Nhấp chuột vào đây để mở rộng...
Em đã đổi theo code của bác rồi, nhưng code này của bác là nó vẫn chạy như cũ phải không ạ ?
Giờ em lại phát sinh thêm nhu cầu nữa là: Trong sheet "Tong hop" của file Tổng hợp và các file con em phải thêm một số cột từ cột R , hiện tại em thêm vào rồi nhưng khi có thêm dữ liệu thì không ổn vì các dòng dữ liệu từ cột R không được đẩy xuống theo, các bác sửa giùm em với ạ. Em cảm ơn sự nhiệt tình của các bác rất nhiều :)
 
hhn đã viết:
Em đã đổi theo code của bác rồi, nhưng code này của bác là nó vẫn chạy như cũ phải không ạ ?
Giờ em lại phát sinh thêm nhu cầu nữa là: Trong sheet "Tong hop" của file Tổng hợp và các file con em phải thêm một số cột từ cột R , hiện tại em thêm vào rồi nhưng khi có thêm dữ liệu thì không ổn vì các dòng dữ liệu từ cột R không được đẩy xuống theo, các bác sửa giùm em với ạ. Em cảm ơn sự nhiệt tình của các bác rất nhiều :)
Nhấp chuột vào đây để mở rộng...
Cho em hỏi thêm vấn đề nữa là: nếu em chỉ cần lấy dữ liệu ở các file con đến cột O thì chỉ cần sửa dòng này "wkb.Sheets(aWks(j)).Range ("B6: Q10000"). ClearContents" thôi đúng 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

S
Slicer không chuyển qua trạng thái mờ.
Trả lời
3
Đọc
73
hoangtuaotrang_hp_vn
H
S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
2
Trả lời
27
Đọc
451
befaint
befaint
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2 3
Trả lời
54
Đọc
726
ptm0412
ptm0412
K
Tính tổng có điều kiện
Trả lời
3
Đọc
73
HieuCD
H
kyo
  • Suggestion
Bài viết: SAP Scripting – Excel và SAP (P2)
    • Thích
Trả lời
11
Đọc
8K
Tình nghĩa giang hồ
Tình nghĩa giang hồ
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