E nhờ các Thầy, Cô, Anh Chị giúp Em vấn đề cộng dữ liệu các Sheet ạ!

dangky47h · 19/7/18

Dữ liệu ở Cột C "Tên vật tư" và cột D " Khối lượng" sẽ được tổng cộng lại ở các sheet (01 đến 10 ) vào sheet "Tong hop"

Em xin cám ơn nhìu!

vanaccex · 19/7/18

dangky47h đã viết:
Dữ liệu ở Cột C "Tên vật tư" và cột D " Khối lượng" sẽ được tổng cộng lại ở các sheet (01 đến 10 ) vào sheet "Tong hop"View attachment 199909 View attachment 199910 View attachment 199911
Em xin cám ơn nhìu!

Bạn thử dùng Consolidate xem

dangky47h · 19/7/18

vanaccex đã viết:
Bạn thử dùng Consolidate xemView attachment 199914

E cám ơn a! Cái này chắc dùng code nhanh hơn đúng không Chị?

vanaccex · 19/7/18

dangky47h đã viết:
E cám ơn a! Cái này chắc dùng code nhanh hơn đúng không Chị?

Tùy bạn thôi, Bởi trong excel có sẵn rồi nên cũng không muốn code

giaiphap · 20/7/18

dangky47h đã viết:
Dữ liệu ở Cột C "Tên vật tư" và cột D " Khối lượng" sẽ được tổng cộng lại ở các sheet (01 đến 10 ) vào sheet "Tong hop"View attachment 199909 View attachment 199910 View attachment 199911
Em xin cám ơn nhìu!

Bạn tự kiểm tra nhé.

Mã:

Sub GPE()
'On Error Resume Next
Dim Dic, dArr(1 To 1000, 1 To 8), Arr, Tmp
Dim i As Long, m As Long, j As Long, k As Long
Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To 10
        With Sheets(Format(i, "00"))
            Arr = .UsedRange.Value
            For j = 2 To UBound(Arr)
                Tmp = Arr(j, 3)
                With Dic
                    If Not .Exists(Tmp) Then
                        k = k + 1
                        .Add Tmp, k
                        dArr(k, 1) = k
                        For m = 1 To 7
                            dArr(k, m + 1) = Arr(j, m + 1)
                        Next m
                    Else
                        dArr(.Item(Tmp), 4) = dArr(.Item(Tmp), 4) + Arr(j, 4)
                    End If
                 End With
             Next j
        End With
  Next i
  With Sheet2
    .[A2:H1000].ClearContents
    If k Then .[A2].Resize(k, 8).Value = dArr
  End With
  Set Dic = Nothing
End Sub

dangky47h · 20/7/18

giaiphap đã viết:

Bạn tự kiểm tra nhé.

Mã:

Sub GPE()
'On Error Resume Next
Dim Dic, dArr(1 To 1000, 1 To 8), Arr, Tmp
Dim i As Long, m As Long, j As Long, k As Long
Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To 10
        With Sheets(Format(i, "00"))
            Arr = .UsedRange.Value
            For j = 2 To UBound(Arr)
                Tmp = Arr(j, 3)
                With Dic
                    If Not .Exists(Tmp) Then
                        k = k + 1
                        .Add Tmp, k
                        dArr(k, 1) = k
                        For m = 1 To 7
                            dArr(k, m + 1) = Arr(j, m + 1)
                        Next m
                    Else
                        dArr(.Item(Tmp), 4) = dArr(.Item(Tmp), 4) + Arr(j, 4)
                    End If
                 End With
             Next j
        End With
  Next i
  With Sheet2
    .[A2:H1000].ClearContents
    If k Then .[A2].Resize(k, 8).Value = dArr
  End With
  Set Dic = Nothing
End Sub

Vâng, E cám ơn Thầy ạ!

Bài đã được tự động gộp: 20/7/18

giaiphap đã viết:

Bạn tự kiểm tra nhé.

Mã:

Sub GPE()
'On Error Resume Next
Dim Dic, dArr(1 To 1000, 1 To 8), Arr, Tmp
Dim i As Long, m As Long, j As Long, k As Long
Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To 10
        With Sheets(Format(i, "00"))
            Arr = .UsedRange.Value
            For j = 2 To UBound(Arr)
                Tmp = Arr(j, 3)
                With Dic
                    If Not .Exists(Tmp) Then
                        k = k + 1
                        .Add Tmp, k
                        dArr(k, 1) = k
                        For m = 1 To 7
                            dArr(k, m + 1) = Arr(j, m + 1)
                        Next m
                    Else
                        dArr(.Item(Tmp), 4) = dArr(.Item(Tmp), 4) + Arr(j, 4)
                    End If
                 End With
             Next j
        End With
  Next i
  With Sheet2
    .[A2:H1000].ClearContents
    If k Then .[A2].Resize(k, 8).Value = dArr
  End With
  Set Dic = Nothing
End Sub

E chạy thấy báo lỗi, là do đâu vậy ạ!

namkpac · 20/7/18

dangky47h đã viết:
Vâng, E cám ơn Thầy ạ!

Bài đã được tự động gộp: 20/7/18

E chạy thấy báo lỗi, là do đâu vậy ạ!View attachment 200019

Có lỗi nào đâu bạn? test thử cho bạn có thấy lỗi gì đâu kết quả ok mà.

gttrongvn · 20/7/18

dangky47h đã viết:
Vâng, E cám ơn Thầy ạ!

Bài đã được tự động gộp: 20/7/18

E chạy thấy báo lỗi, là do đâu vậy ạ!View attachment 200019

File bạn up lên diễn đàn và file bạn chạy không phải là một file, file bạn up name của các bảng tính là Sheet...., hình bạn chụp lên name của các bảng tính là Trang_tinh... nên code bị lỗi là phải rồi.

dangky47h · 20/7/18

gttrongvn đã viết:
File bạn up lên diễn đàn và file bạn chạy không phải là một file, file bạn up name của các bảng tính là Sheet...., hình bạn chụp lên name của các bảng tính là Trang_tinh... nên code bị lỗi là phải rồi.

E insert vào mudule và chạy mà, nhờ Anh (Chị ) kiểm tra lại giúp E ạ!

Bài đã được tự động gộp: 20/7/18

namkpac đã viết:
Có lỗi nào đâu bạn? test thử cho bạn có thấy lỗi gì đâu kết quả ok mà.[/QUOT
Vâng, không hiểu sao Em chạy code vẫn thấy báo lỗi ạ!

Bài đã được tự động gộp: 20/7/18

namkpac đã viết:
Có lỗi nào đâu bạn? test thử cho bạn có thấy lỗi gì đâu kết quả ok mà.

Anh (Chị) gửi lại file mà đã Test cho e xin được không ạ!

gttrongvn · 20/7/18

dangky47h đã viết:
Anh (Chị) gửi lại file mà đã Test cho e xin được không ạ!

Bạn download file bạn đã up lên ở bài #1 rồi bỏ vào là chạy thôi mà.

dangky47h · 20/7/18

gttrongvn đã viết:
Bạn download file bạn đã up lên ở bài #1 rồi bỏ vào là chạy thôi mà.

Đây ạ! nhưng vẫn bị lỗi ạ!

gttrongvn · 20/7/18

Đây nè, mình copy code của anh GiaiPhap vô cho bạn rồi, bạn chạy thử xem

dangky47h · 20/7/18

gttrongvn đã viết:
Đây nè, mình copy code của anh GiaiPhap vô cho bạn rồi, bạn chạy thử xem

Ok cám ơn bạn nhìu, mình làm được rồi nhé!

lengoc1490 · 21/7/18

Bạn xem file này nhé. Mình mới tập code chắc chưa tối ưu lắm.
Mình có tạo thêm 1 sheets("TH") để tổng hợp DL thô trong tất cả các sheet vào 1 sheet. Và có 1 cái tính tổng như yêu cầu của bạn.
Bạn đóng góp ý kiến để cùng học hỏi nhé.

vanle33 · 21/7/18

giaiphap đã viết:
Bạn tự kiểm tra

Bạn chỉnh sửa code để:
Tổng hợp theo cả tiêu chí theo cột Mục đích sử dụng và cột Ghi chú (cột H) được không?
Ví dụ cùng tên vật tư là: "Gạch Ceramic 300x300" nhưng có hai mục đích sử dụng và Ghi chú khác nhau (Dòng 10 và dòng 12 của sheet 01).
Nhá.

dangky47h · 21/7/18

lengoc1490 đã viết:
Bạn xem file này nhé. Mình mới tập code chắc chưa tối ưu lắm.
Mình có tạo thêm 1 sheets("TH") để tổng hợp DL thô trong tất cả các sheet vào 1 sheet. Và có 1 cái tính tổng như yêu cầu của bạn.
Bạn đóng góp ý kiến để cùng học hỏi nhé.

Cảm ơn bạn nhé!

phihndhsp · 21/7/18

giaiphap đã viết:
Bạn tự kiểm tra nhé.

Mượn code của giải pháp để viết theo khuôn mẫu. Cảm ơn giải pháp nhiều nha

Mã:

Sub main()
Dim i As Long
Dim K As Long
Dim Arr_D(1 To 1000, 1 To 8)
Dim Dic As Object
Dim Sh As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
K = 0
For i = 1 To 10
Call Khuon(Sheets(Format(i, "00")), Dic, Arr_D, K)
Next
  Sheet2.Range("A2:Z10000").Clear
  Sheet2.Range("A2").Resize(K, 8) = Arr_D
  Set Dic = Nothing
End Sub

Sub Khuon(Sh As Worksheet, Dic As Object, Arr_D(), K As Long)
Dim Arr_N()
Dim i As Long, J As Long, Dcuoi As Long
Dcuoi = Sh.Range("C10000").End(xlUp).Row
Arr_N = Sh.Range("A2:H" & Dcuoi)
For i = 1 To UBound(Arr_N, 1)
   If Trim(Arr_N(i, 3)) <> "" Then
     If Not Dic.Exists(Arr_N(i, 3)) Then
          K = K + 1
          Dic.Add Arr_N(i, 3), K
          Arr_D(K, 1) = K
          For J = 2 To 8
              Arr_D(K, J) = Arr_N(i, J)
           Next J
      Else
          Arr_D(Dic.Item(Arr_N(i, 3)), 4) = Arr_D(Dic.Item(Arr_N(i, 3)), 4) + Arr_N(i, 4)
      End If
    End If
  Next i
End Sub

dangky47h · 21/7/18

lengoc1490 đã viết:
Bạn xem file này nhé. Mình mới tập code chắc chưa tối ưu lắm.
Mình có tạo thêm 1 sheets("TH") để tổng hợp DL thô trong tất cả các sheet vào 1 sheet. Và có 1 cái tính tổng như yêu cầu của bạn.
Bạn đóng góp ý kiến để cùng học hỏi nhé.

phihndhsp đã viết:

Mượn code của giải pháp để viết theo khuôn mẫu. Cảm ơn giải pháp nhiều nha

Mã:

Sub main()
Dim i As Long
Dim K As Long
Dim Arr_D(1 To 1000, 1 To 8)
Dim Dic As Object
Dim Sh As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
K = 0
For i = 1 To 10
Call Khuon(Sheets(Format(i, "00")), Dic, Arr_D, K)
Next
  Sheet2.Range("A2:Z10000").Clear
  Sheet2.Range("A2").Resize(K, 8) = Arr_D
  Set Dic = Nothing
End Sub

Sub Khuon(Sh As Worksheet, Dic As Object, Arr_D(), K As Long)
Dim Arr_N()
Dim i As Long, Ii As Long, J As Long, Dcuoi As Long
Dcuoi = Sh.Range("C10000").End(xlUp).Row
Arr_N = Sh.Range("A2:H" & Dcuoi)
For i = 1 To UBound(Arr_N, 1)
   If Trim(Arr_N(i, 3)) <> "" Then
     If Not Dic.Exists(Arr_N(i, 3)) Then
          K = K + 1
          Dic.Add Arr_N(i, 3), K
          Arr_D(K, 1) = K
          For J = 2 To 8
              Arr_D(K, J) = Arr_N(i, J)
           Next J
      Else
          Arr_D(Dic.Item(Arr_N(i, 3)), 4) = Arr_D(Dic.Item(Arr_N(i, 3)), 4) + Arr_N(i, 4)
      End If
    End If
  Next i
End Sub

E cám ơn Anh ạ!

E nhờ các Thầy, Cô, Anh Chị giúp Em vấn đề cộng dữ liệu các Sheet ạ!

Thành viên thường trực

File đính kèm

Thành viên tiêu biểu

Thành viên thường trực

Thành viên tiêu biểu

==(^o^)==

Thành viên thường trực

Thành viên thường trực

Thành viên hoạt động

Thành viên thường trực

File đính kèm

Thành viên hoạt động

Thành viên thường trực

File đính kèm

Thành viên hoạt động

File đính kèm

Thành viên thường trực

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên thường trực

Thành viên gạo cội

File đính kèm

Thành viên thường trực

Facebook

Group