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

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
312
Được thích
33
Điểm
185
Tuổi
32
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"0.jpg1.jpg2.jpg
Em xin cám ơn nhìu!
 

File đính kèm

vanaccex

Thành viên thường trực
Tham gia ngày
8 Tháng bảy 2018
Bài viết
311
Được thích
137
Điểm
195

giaiphap

Thành viên gạo cội
Tham gia ngày
12 Tháng ba 2007
Bài viết
4,818
Được thích
4,068
Điểm
860
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 199909View attachment 199910View 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

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
312
Được thích
33
Điểm
185
Tuổi
32
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:

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 ạ!1233.jpg
 

namkpac

Thành viên thường trực
Tham gia ngày
25 Tháng mười một 2008
Bài viết
274
Được thích
9
Điểm
685

gttrongvn

Thành viên hoạt động
Tham gia ngày
20 Tháng sáu 2011
Bài viết
139
Được thích
80
Điểm
380
Vâng, E cám ơn Thầy ạ!
Bài đã được tự động gộp:


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

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
312
Được thích
33
Điểm
185
Tuổi
32
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:

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:

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 ạ!
 

File đính kèm

Lần chỉnh sửa cuối:

lengoc1490

Thành viên mới
Tham gia ngày
21 Tháng tám 2014
Bài viết
9
Được thích
0
Điểm
363
Tuổi
29
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é.
 

File đính kèm

vanle33

Thành viên gạo cội
Tham gia ngày
30 Tháng mười 2008
Bài viết
5,491
Được thích
3,750
Điểm
860
Nơi ở
Thị xã Sơn Tây - TP Hà Nội
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

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
312
Được thích
33
Điểm
185
Tuổi
32
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

Thành viên gạo cội
Tham gia ngày
26 Tháng mười hai 2009
Bài viết
3,298
Được thích
2,386
Điểm
560
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
 

File đính kèm

Lần chỉnh sửa cuối:

dangky47h

Thành viên thường trực
Tham gia ngày
4 Tháng chín 2017
Bài viết
312
Được thích
33
Điểm
185
Tuổi
32
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é.
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 ạ!
 
Top Bottom