Tổng hợp dữ liệu từ nhiều sheet vào một sheet (4 người xem)

[donhungtin2013]

Trong file đính kèm em muốn lấy dữ liệu ở cột C và cột E của các sheet đưa vào sheet tổng hợp để sum, em làm thủ công là copy paste sau đó dùng remove duplicates để loại bỏ những dòng trùng. Tuy nhiên vì file em có rất nhiều sheet và có quá nhiều chủng loại hàng vậy mình có cách nào để đưa dữ liệu vào sheet tổng hợp mà không làm bằng cách thủ công trên không? Mọi người giúp em với em cảm ơn nhiều.

 

[giangleloi]

Trong file đính kèm em muốn lấy dữ liệu ở cột C và cột E của các sheet đưa vào sheet tổng hợp để sum, em làm thủ công là copy paste sau đó dùng remove duplicates để loại bỏ những dòng trùng. Tuy nhiên vì file em có rất nhiều sheet và có quá nhiều chủng loại hàng vậy mình có cách nào để đưa dữ liệu vào sheet tổng hợp mà không làm bằng cách thủ công trên không? Mọi người giúp em với em cảm ơn nhiều.

Tặng bạn đoạn code này, chắc bạn tự biết bỏ vô xài rùi nhỉ:

Sub GPE()
Dim Ws, Dic, I, K, Arr(), vlArr(1 To 10000, 1 To 3), Tem
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In ThisWorkbook.Worksheets
 With Ws
  Arr = .Range(.[C9], .[C65000].End(3)).Resize(, 3).Value
    For I = 1 To UBound(Arr)
       Tem = Arr(I, 1)
         If Left(Tem, 1) = "H" Then
          If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, ""
            vlArr(K, 1) = K
            vlArr(K, 2) = Arr(I, 1)
            vlArr(K, 3) = Arr(I, 3)
          End If
         End If
    Next I
  End With
Next
    Sheet5.[B8:D10000].ClearContents
    Sheet5.[B8].Resize(K, 3) = vlArr
Set Dic = Nothing
End Sub

P/s: Trùng của bạn nói là trùng cả dòng hay chỉ cột C?

 

[giangleloi]

Trong file đính kèm em muốn lấy dữ liệu ở cột C và cột E của các sheet đưa vào sheet tổng hợp để sum, em làm thủ công là copy paste sau đó dùng remove duplicates để loại bỏ những dòng trùng. Tuy nhiên vì file em có rất nhiều sheet và có quá nhiều chủng loại hàng vậy mình có cách nào để đưa dữ liệu vào sheet tổng hợp mà không làm bằng cách thủ công trên không? Mọi người giúp em với em cảm ơn nhiều.

Hoặc là thử cái này. Cái nào hợp ý thì xài:

Sub GPE()
Dim Ws, Dic, I, K, Arr(), vlArr(1 To 10000, 1 To 3), Tem
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In ThisWorkbook.Worksheets
 With Ws
  Arr = .Range(.[C9], .[C65000].End(3)).Resize(, 3).Value
    For I = 1 To UBound(Arr)
       Tem = Arr(I, 1) & "#" & Arr(I, 3)
         If Left(Arr(I, 1), 1) = "H" Then
          If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, ""
            vlArr(K, 1) = K
            vlArr(K, 2) = Arr(I, 1)
            vlArr(K, 3) = Arr(I, 3)
          End If
         End If
    Next I
  End With
Next
    Sheet5.[B8:D10000].ClearContents
    Sheet5.[B8].Resize(K, 3) = vlArr
Set Dic = Nothing
End Sub

 

[donhungtin2013]

Hoặc là thử cái này. Cái nào hợp ý thì xài:

Sub GPE()
Dim Ws, Dic, I, K, Arr(), vlArr(1 To 10000, 1 To 3), Tem
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In ThisWorkbook.Worksheets
 With Ws
  Arr = .Range(.[C9], .[C65000].End(3)).Resize(, 3).Value
    For I = 1 To UBound(Arr)
       Tem = Arr(I, 1) & "#" & Arr(I, 3)
         If Left(Arr(I, 1), 1) = "H" Then
          If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, ""
            vlArr(K, 1) = K
            vlArr(K, 2) = Arr(I, 1)
            vlArr(K, 3) = Arr(I, 3)
          End If
         End If
    Next I
  End With
Next
    Sheet5.[B8:D10000].ClearContents
    Sheet5.[B8].Resize(K, 3) = vlArr
Set Dic = Nothing
End Sub

Anh ơi em copy đoạn code dán vào mà sao nó không chạy anh à, hay anh add vào file giúp em với

 

[comet_1701]

Anh ơi em copy đoạn code dán vào mà sao nó không chạy anh à, hay anh add vào file giúp em với

Bạn đã Enable Macro chưa
http://www.giaiphapexcel.com/forum/...ẫn-Enable-Macros-trong-Excel-(2003-2007-2010)

 

[giangleloi]

Anh ơi em copy đoạn code dán vào mà sao nó không chạy anh à, hay anh add vào file giúp em với

File thì có file đâyEnable macro rồi bấm vô mặt cười)