Nhờ giúp viết code tổng hợp dữ liệu

[chickenexcel]

Kính gửi các bac GPE!
Xin nhờ các bác giúp em viết code để tổng hợp số lượng từ sheet "phiếu xuất hàng" vào sheet "tổng hợp" với điều kiện: theo đúng tên sản phẩm, số lô và kho hàng
các số lượng được xuất tiếp tục được cộng dồn vào cột xuất kho bên sheet" Tổng hợp" ạ!
Em đang học VBA nên chủ yếu sửa code macro những cái đơn giản, mấy cái cần điều kiện thế này xin nhờ các bác giúp ạ!
Em cảm ơn!

 

[leonguyenz]

Kính gửi các bac GPE!
Xin nhờ các bác giúp em viết code để tổng hợp số lượng từ sheet "phiếu xuất hàng" vào sheet "tổng hợp" với điều kiện: theo đúng tên sản phẩm, số lô và kho hàng
các số lượng được xuất tiếp tục được cộng dồn vào cột xuất kho bên sheet" Tổng hợp" ạ!
Em đang học VBA nên chủ yếu sửa code macro những cái đơn giản, mấy cái cần điều kiện thế này xin nhờ các bác giúp ạ!
Em cảm ơn!

Tham khảo code và file đính kèm.

Sub Oval2_Click()
Dim Rng As Range, Pxk(), i As Integer, j As Integer, iTmp As Integer
Dim Tmp As String, xTmp As String, Kho As Byte, Dic As Object, k As Integer
Set Rng = Sheet1.Range("A3:G" & Sheet1.Range("C65535").End(xlUp).Row)
Pxk = Sheet2.Range("B8:F" & Sheet2.Range("B65535").End(xlUp).Row).Value
Kho = IIf(Sheet2.Range("B5").Value = "Kho A", 6, 7)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To Rng.Rows.Count
    Tmp = UCase(Rng(i, 3).Value & " " & Rng(i, 4).Value)
    If Not Dic.Exists(Tmp) Then
        k = k + 1
        Dic.Add Tmp, k
    End If
Next i
For j = 1 To UBound(Pxk, 1)
    xTmp = UCase(Pxk(j, 1) & " " & Pxk(j, 3))
    If Not Dic.Exists(xTmp) Then
        k = k + 1
        Dic.Add xTmp, k
        Rng(k, 1) = k
        Rng(k, 3) = Pxk(j, 1)
        Rng(k, 4) = Pxk(j, 3)
        Rng(k, Kho) = Pxk(j, 2)
    Else
        iTmp = Dic.Item(xTmp)
        Rng(iTmp, Kho).Value = Rng(iTmp, Kho).Value + Pxk(j, 2)
    End If
Next j
End Sub

 

[chickenexcel]

Thank bác leonguyenz đã quan tâm và trả lời, do sơ xuất nên phần sheet tổng hợp e có trình bày chưa đúng, dữ liệu tại sheet đó các dòng không liền nhau nên khi em nhấn nó chưa thực hiện được ạ
em muốn là khi update thì công thức vẫn giữ nguyên được ko ạ?: VD cam (lô ca2)=100+200
thì khi update thêm 500 phần phiếu nhập sẽ =100+200+500 (để kiểm soát số lượng mỗi lần xuất)
Với các mặt hàng không có trong danh mục sheet tổng hợp thì không cần thêm vào ạ (nếu được a cho em cái msgbox thông báo: số thứ tự ...(hoặc số lô ...) trên phiếu lĩnh ko có) ạ
Chúc bác và gia đình 30/4-1/5 vui vẻ nhé!

 

[leonguyenz]

Thank bác leonguyenz đã quan tâm và trả lời, do sơ xuất nên phần sheet tổng hợp e có trình bày chưa đúng, dữ liệu tại sheet đó các dòng không liền nhau nên khi em nhấn nó chưa thực hiện được ạ
em muốn là khi update thì công thức vẫn giữ nguyên được ko ạ?: VD cam (lô ca2)=100+200
thì khi update thêm 500 phần phiếu nhập sẽ =100+200+500 (để kiểm soát số lượng mỗi lần xuất)
Với các mặt hàng không có trong danh mục sheet tổng hợp thì không cần thêm vào ạ (nếu được a cho em cái msgbox thông báo: số thứ tự ...(hoặc số lô ...) trên phiếu lĩnh ko có) ạ
Chúc bác và gia đình 30/4-1/5 vui vẻ nhé!

Ok, tôi đã sửa code, có để lại code cũ trong file đính kèm.

Sub Oval2_Click2()
Dim Rng As Range, Pxk(), i As Integer, j As Integer, iTmp As Integer
Dim Tmp As String, xTmp As String, Kho As Byte, Dic As Object, k As Integer
Set Rng = Sheet1.Range("A3:G" & Sheet1.Range("C65535").End(xlUp).Row)
Pxk = Sheet2.Range("B8:F" & Sheet2.Range("B65535").End(xlUp).Row).Value
Kho = IIf(Sheet2.Range("B5").Value = "Kho A", 6, 7)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To Rng.Rows.Count
    Tmp = UCase(Rng(i, 3).Value & " " & Rng(i, 4).Value)
    If Not Dic.Exists(Tmp) Then
        Dic.Add Tmp, i
    End If
Next i
Dic.Remove " "
k = Rng.Rows.Count
For j = 1 To UBound(Pxk, 1)
    xTmp = UCase(Pxk(j, 1) & " " & Pxk(j, 3))
    If Not Dic.Exists(xTmp) Then
        MsgBox "Ten Hang: " & Pxk(j, 1) & Chr(10) & "So Lo: " & Pxk(j, 3)
        k = k + 1
        Dic.Add xTmp, k
        Rng(k, 1) = Dic.Count
        Rng(k, 3) = Pxk(j, 1)
        Rng(k, 4) = Pxk(j, 3)
        If Rng(k, Kho).HasFormula Then
            Rng(k, Kho).Formula = Rng(k, Kho).Formula & "+" & Pxk(j, 2)
        Else
            Rng(k, Kho).Formula = "=" & Rng(k, Kho).Formula & "+" & Pxk(j, 2)
        End If
    Else
        iTmp = Dic.Item(xTmp)
        If Rng(iTmp, Kho).HasFormula Then
            Rng(iTmp, Kho).Formula = Rng(iTmp, Kho).Formula & "+" & Pxk(j, 2)
        Else
            Rng(iTmp, Kho) = "=" & Rng(iTmp, Kho).Value & "+" & Pxk(j, 2)
        End If
    End If
Next j

If k > Rng.Rows.Count Then
    Sheet1.Range("A3").Resize(k, 7).Borders.LineStyle = 1
End If
End Sub

 

[chickenexcel]

Cảm ơn bác leonguyenz !
code chạy rất chuẩn ạ, tuy nhiên những mặt hàng không có em không cần update vào, bác sửa lại code giúp e với

Với các mặt hàng không có trong danh mục sheet tổng hợp thì không cần thêm vào ạ

Với cả 1 phiếu xuất sẽ không xuất cùng lúc 1 lô đâu ạ

 

[leonguyenz]

Cảm ơn bác leonguyenz !
code chạy rất chuẩn ạ, tuy nhiên những mặt hàng không có em không cần update vào, bác sửa lại code giúp e với

Với cả 1 phiếu xuất sẽ không xuất cùng lúc 1 lô đâu ạ

Tôi chưa hiểu 1 phiếu xuất sẽ không xuất cùng lúc 1 lô?

 

[chickenexcel]

Tôi chưa hiểu 1 phiếu xuất sẽ không xuất cùng lúc 1 lô?

Vâng, có nghĩa là trong 1 phiếu xuất sẽ ko xuất cùng lúc 1 mặt hàng cùng lô cho kho ạ, vd: cam số lô: ca2, thì trên phiếu sẽ chỉ được xuất 1 lần thôi ạ, ko được trùng lặp 2 lô cam (ca2) trên phiếu (nghe hơi vô lý nhưng mặt hàng chỗ e nó vậy )
Nhưng cái đó ko quan trọng, vì code của bác vẫn đúng, bác rất cẩn thận nên đã tính luôn phần đó cho e
E chỉ cần sửa ko up mặt hàng mới vào thôi ạ

 

[leonguyenz]

Vâng, có nghĩa là trong 1 phiếu xuất sẽ ko xuất cùng lúc 1 mặt hàng cùng lô cho kho ạ, vd: cam số lô: ca2, thì trên phiếu sẽ chỉ được xuất 1 lần thôi ạ, ko được trùng lặp 2 lô cam (ca2) trên phiếu (nghe hơi vô lý nhưng mặt hàng chỗ e nó vậy )
Nhưng cái đó ko quan trọng, vì code của bác vẫn đúng, bác rất cẩn thận nên đã tính luôn phần đó cho e
E chỉ cần sửa ko up mặt hàng mới vào thôi ạ

Tham khảo file nhe.

Sub Oval2_Click3()
Dim Rng As Range, Pxk(), i As Integer, j As Integer, iTmp As Integer
Dim Tmp As String, xTmp As String, Kho As Byte, Dic As Object, k As Integer
Set Rng = Sheet1.Range("A3:G" & Sheet1.Range("C65535").End(xlUp).Row)
Pxk = Sheet2.Range("B8:F" & Sheet2.Range("B65535").End(xlUp).Row).Value
Kho = IIf(Sheet2.Range("B5").Value = "Kho A", 6, 7)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To Rng.Rows.Count
    Tmp = UCase(Rng(i, 3).Value & " " & Rng(i, 4).Value)
    If Not Dic.Exists(Tmp) Then
        Dic.Add Tmp, i
    End If
Next i
Dic.Remove " "

For j = 1 To UBound(Pxk, 1)
    xTmp = UCase(Pxk(j, 1) & " " & Pxk(j, 3))
    If Not Dic.Exists(xTmp) Then
        k = k + 1
        'Dic.Add xTmp, k
        MsgBox "New: " & k & Chr(10) & "Ten Hang: " & _
            Pxk(j, 1) & Chr(10) & "So Lo: " & Pxk(j, 3)
    Else
        iTmp = Dic.Item(xTmp)
        If Rng(iTmp, Kho).HasFormula Then
            Rng(iTmp, Kho).Formula = Rng(iTmp, Kho).Formula & "+" & Pxk(j, 2)
        Else
            Rng(iTmp, Kho) = "=" & Rng(iTmp, Kho).Value & "+" & Pxk(j, 2)
        End If
    End If
Next j
End Sub

 

[chickenexcel]

làm phiền bác leonguyenz
Sau một thời gian sử dụng code của bác ổn định, lại mới phát sinh vấn đề, khi nhập số lượng lẻ thì bị báo lỗi: VD số lượng 10,2 ; 50,309 ....
đoạn code báo lỗi:

 Rng(iTmp, Kho).Formula = Rng(iTmp, Kho).Formula & "+" & Pxk(j, 2)

Nhờ bác sửa giúp với ạ!
Trân thành cảm ơn!

 

[haiauA]

Xin nhờ các bác giúp đỡ phân bổ số lượng !!

Kính gửi các bác GPE! Xin nhờ các bác giúp đỡ phân bổ số lượng "Lượng sản xuất được" bảng tính B sang "Lượng sản xuất được" ở bảng A theo điều kiện cùng mã. Do bảng tính nhiều nên chỉ ví dụ trên file mong các bác GPE quan tâm giúp đỡ ạ