Lập VBA tổng hợp số liệu với 2 điều kiện cố định (1 người xem)

[ntvlequan]

Chào các Bác

Em là thành viên mới toe
Có 1 vấn đề muốn được các chuyên gia VBA trợ giúp
TRong bảng tính của em có 2 sheet
sheet1PO): là đơn hàng của khách hàng tương ứng với các mã sản phẩm có mã PO, ngày xuất hàng và số lượng xuất:trong đó cùng 1 ngày có thể có nhiều mã PO có số lượng khác nhau của chung 1 mã
Sheet2Link PO) là bảng tổng hợp tất cả các mã sản phẩm và ngày xuất hàng trong cả tháng
Yêu cầu: tính tổng với 2 điều kiện là:cùng mã sản phẩm và cùng ngày xuất hàng.
(em gửi file đính kèm)
vậy Bác nào giỏi về VBA giúp em với
email: Lequan@nisseivn.com

 

[ChanhTQ@]

Bạn thử với file này . . . .

. . . trong khi chờ đợi file khác tốt hơn

 

[Quang_Hải]

Chào các Bác

Em là thành viên mới toe
Có 1 vấn đề muốn được các chuyên gia VBA trợ giúp
TRong bảng tính của em có 2 sheet
sheet1PO): là đơn hàng của khách hàng tương ứng với các mã sản phẩm có mã PO, ngày xuất hàng và số lượng xuất:trong đó cùng 1 ngày có thể có nhiều mã PO có số lượng khác nhau của chung 1 mã
Sheet2Link PO) là bảng tổng hợp tất cả các mã sản phẩm và ngày xuất hàng trong cả tháng
Yêu cầu: tính tổng với 2 điều kiện là:cùng mã sản phẩm và cùng ngày xuất hàng.
(em gửi file đính kèm)
vậy Bác nào giỏi về VBA giúp em với
email: Lequan@nisseivn.com

Code của bạn đây

Sub Capnhat()
Dim dl, kq, i, j, jj
With Sheets("LINK PO")
.[c3:ai10000].ClearContents
kq = .Range(.[b2], .[b65536].End(3)).Resize(, 34).Value
End With
With Sheets("PO")
  dl = .Range(.[a2], .[a65536].End(3)).Resize(, 4)
End With
For i = 1 To UBound(dl)
  For j = 2 To UBound(kq)
    If dl(i, 1) = kq(j, 1) Then
      For jj = 2 To 34
        If Val(dl(i, 3)) = Val(kq(1, jj)) Then
          kq(j, jj) = kq(j, jj) + dl(i, 4)
          Exit For
        End If
      Next
    End If
  Next
Next
Sheets("LINK PO").[b2].Resize(j - 1, 34) = kq
End Sub

 

[Ba Tê]

Thử thêm cái này nữa xem, tốc độ khoảng 0.0468 giây.

Public Sub GPE()
Dim Rng(), Arr(), Dic As Object, Cot As Long, I As Long, J As Long, K As Long, D As Long, Tem As String, t As Variant
Set Dic = CreateObject("Scripting.Dictionary")
t = Timer
With Sheets("LINK PO")
    Rng = .Range(.[B3], .[B65000].End(xlUp)).Value
    D = .[C2].Value
End With
ReDim Arr(1 To UBound(Rng, 1), 1 To 50)
    For I = 1 To UBound(Rng, 1)
        Tem = Rng(I, 1)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add (Tem), K
        End If
    Next I
With Sheets("PO")
    Rng = .Range(.[A2], .[A65000].End(xlUp)).Resize(, 10).Value
End With
    For I = 1 To UBound(Rng, 1)
        If Rng(I, 3) <> "" Then
            Cot = Rng(I, 3) - D + 1
            If Dic.Exists(Rng(I, 1)) Then
                Arr(Dic.Item(Rng(I, 1)), Cot) = Arr(Dic.Item(Rng(I, 1)), Cot) + Rng(I, 4)
            End If
        End If
    Next I
    Sheets("LINK PO").[C3].Resize(K, 50).Value = Arr
Set Dic = Nothing
MsgBox Timer - t
End Sub

 

[ntvlequan]

Cám ơn các Bác rất nhiều, Đúng là học nữa học mãi cũng không hết được Excel
Cái File Link Po đó sau khi update Po của khách hàng bên em lại link( dùng Vlookup) vào 1 file quản lý sản xuất tương ứng với từng ấy mã
Hiện tại cái file đó của bên em là file Excel mà lên tới 12.3MB, thực sự khi làm việc với bảng này rất bất tiện
nếu bác nào có thời gian rảnh xem giúp hộ em file này nữa với nhé
thật sự cảm ơn các Bác, các bạn đã giúp đỡ em vấn đề này.Thanks a Lot

 

[vodoi2x]

Cám ơn các Bác rất nhiều, Đúng là học nữa học mãi cũng không hết được Excel
Cái File Link Po đó sau khi update Po của khách hàng bên em lại link( dùng Vlookup) vào 1 file quản lý sản xuất tương ứng với từng ấy mã
Hiện tại cái file đó của bên em là file Excel mà lên tới 12.3MB, thực sự khi làm việc với bảng này rất bất tiện
nếu bác nào có thời gian rảnh xem giúp hộ em file này nữa với nhé
thật sự cảm ơn các Bác, các bạn đã giúp đỡ em vấn đề này.Thanks a Lot

Thấy ở sheet Link PO của bạn, tại cột B: có những mã sản phẩm bị trùng nhau ==> điều này rất lạ cho THỐNG KÊ
và
Khi đó CODE của pác BaTe sẽ sai kết quả VÌ KẾT QUẢ đặt theo vị trí K -- tuy nhiên bảng thực tế lại bố trí theo vị trí I, đoạn CODE dẫn đến sai đó
là vì K sẽ làm sai lệch vị trí

For I = 1 To UBound(Rng, 1)
Tem = Rng(I, 1)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add (Tem), K
End If
Next I
...................
Sheets("LINK PO").[C3].Resize(K, 50).Value = Arr

Bạn cứ thử so sánh với SUMPRODUCT sẽ thấy kết quả bị lệch hàng từ vị trí row bắt đầu có MÃ SP lặp (ở sheet LINH PO) nhé

 

[ThuNghi]

Cám ơn các Bác rất nhiều, Đúng là học nữa học mãi cũng không hết được Excel
Cái File Link Po đó sau khi update Po của khách hàng bên em lại link( dùng Vlookup) vào 1 file quản lý sản xuất tương ứng với từng ấy mã
Hiện tại cái file đó của bên em là file Excel mà lên tới 12.3MB, thực sự khi làm việc với bảng này rất bất tiện
nếu bác nào có thời gian rảnh xem giúp hộ em file này nữa với nhé
thật sự cảm ơn các Bác, các bạn đã giúp đỡ em vấn đề này.Thanks a Lot

Theo ý tôi thì sh LinkPO là kết quả từ PO.
Vậy những mã và sl trong sh LinkPO phải thuộc về sh PO.
Nhưng có vài mã mà sh PO có mà LibkPO kg có.
Đề xuất như sau:
1/ Sh LinkPO là rỗng và cho 1 cell để chọn tháng báo cáo.
2/ Từ tháng => ngày đầu và ngày cuối, vấn đề này cũng có thể kg cần.
3/ Từ Sh PO lọc lấy nhừng record nào mà có ngày xuất hàng <> "" và sl > 0 thì tổng hợp lại.
4/ Gán Kết quả vào sh LinkPO.
Bài này mà anh Hai Lúa dùng ADO thì nhanh lắm.

 

[ntvlequan]

Vâng đúng là kết quả theo cách làm của Bác Ba Tê bị lệch so với dùng SumProduct
Nhưng trong sheet Link PO của em không có mã nào lặp cả, em đã check lại bằng countif
Bác Ba Tê có Thể nghiên cứu lại giúp em được ko?
bên Sheet Link PO có thể để trống cột Mã sản phẩm và sẽ tự động điền vào theo bên sheet Po ( mỗi mã xuất hiện 1 lần)

 

[ntvlequan]

Mã Code của Bác Quanghai1969 chạy là em thấy ổn và kết quả chính xác
Cám ơn Bác nhiều

 

[ntvlequan]

Sorry Bac Vodoi2x nhé, em kiểm tra lại thì đúng là có mấy mã bị lặp,
nhưng nếu dùng theo cách của Bac quanghai1969 thì không vấn đề gì.

 

[Quang_Hải]

Sorry Bac Vodoi2x nhé, em kiểm tra lại thì đúng là có mấy mã bị lặp,
nhưng nếu dùng theo cách của Bac quanghai1969 thì không vấn đề gì.

Lúc mình làm thì đã thấy vụ này, nhưng mình oánh võ rừng nên vẫn ra kết quả đúng, nhưng nếu bạn sum kết quả này để báo cáo là có thể sai đấy.

 

[ntvlequan]

Em gửi các Bác file Quản lý SX lấy dữ liệu từ file Link PO
http://www.mediafire.com/?n01sp7bv40mx2b6

 

[Quang_Hải]

Em gửi các Bác file Quản lý SX lấy dữ liệu từ file Link PO
http://www.mediafire.com/?n01sp7bv40mx2b6

1. File của bạn có quá nhiều công thức link tới đâu đâu nên xem qua thì nản lòng
2. Font chữ cũng hơi lạ nên nản thêm tí nữa
3. Ban cần xử lý chỗ nào cũng không biết luôn, nản thêm tí nữa
4. Lẽ ra nên xóa bớt dữ liệu, chỉ gởi dữ liệu mẫu là đủ, mình xài 3G nên down cài file nặng thế này tốn tiền quá. Nản thêm tí nữa

Cuối cùng là quyết định đợi xem kết quả từ các thành viên khác

 

[vodoi2x]

Bác Ba Tê có Thể nghiên cứu lại giúp em được ko?
bên Sheet Link PO có thể để trống cột Mã sản phẩm và sẽ tự động điền vào theo bên sheet Po ( mỗi mã xuất hiện 1 lần)

trong khi chờ đợi pác BaTe
thì tạm dùng CODE này, xem ở file kem, tự động cập nhập các MÃ từ sheet PO

Public Sub GPE22()
    On Error GoTo 1:
    Dim Rng(), Arr(), Dic As Object, t, lCal
    Dim c As Long, i As Long, K As Long, D As Long, Tem As String
    Application.ScreenUpdating = False
    lCal = Application.Calculation: Application.Calculation = xlCalculationManual
    t = Timer
    Const nCol = 35
    Set Dic = CreateObject("Scripting.Dictionary")
    
    
    With Sheets("LINK PO")
        K = .[B65000].End(xlUp).Row:
        If K > 2 Then .[A3].Resize(K - 2, nCol).ClearContents
        D = .[C2].Value
    End With
    
    With Sheets("PO"): Rng = .Range(.[A2], .[A65000].End(xlUp)).Resize(, 4).Value: End With
    ReDim Arr(1 To UBound(Rng, 1), 1 To nCol)
    K = 0
    For i = 1 To UBound(Rng, 1)
        If Rng(i, 3) <> "" Then
            c = Rng(i, 3) - D + 1 + 2
            Tem = Rng(i, 1)
            If Dic.Exists(Tem) Then
                Arr(Dic.Item(Rng(i, 1)), c) = Arr(Dic.Item(Rng(i, 1)), c) + Rng(i, 4)
            Else
                K = K + 1: Dic.Add (Tem), K
                Arr(K, 1) = K: Arr(K, 2) = Tem: Arr(K, c) = Rng(i, 4)
            End If
        End If
    Next i
    Set Dic = Nothing
    Sheets("LINK PO").[A3].Resize(K, nCol).Value = Arr
1:  Application.ScreenUpdating = True: Application.Calculation = lCal
    MsgBox Timer - t
End Sub