Bạn xem file thử .Em có nhu cầu cần tổng hợp vật tư xuất cho từng sản phẩm theo định mức có sẵn, chi tiết em mô tả trong file đính kèm, rất mong các anh chị và các bạn trong diễn đàn giúp em bằng cách thuận tiện nhất. Em cảm ơn mọi người rất nhiều.
Rất cảm ơn Maika8008, file bạn gửi đã đáp ứng được nhu cầu của mình. Nhờ bạn xem lại mã sản phẩm SPH0004 mình sửa kiểu gì cũng không cập nhật giá và thành tiền, đồng thời nhờ Bạn bổ sung thêm dòng Tổng cộng sheet "ket_qua" và giúp mình nội dung sheet "canh_bao" (nãy mình chưa nói đến nên chắc bạn chưa xem đến)Bạn xem file thử .
Thử code.Em có nhu cầu cần tổng hợp vật tư xuất cho từng sản phẩm theo định mức có sẵn, chi tiết em mô tả trong file đính kèm, rất mong các anh chị và các bạn trong diễn đàn giúp em bằng cách thuận tiện nhất. Em cảm ơn mọi người rất nhiều.
Sub laygiatri()
Dim i As Long, lr As Long, dic As Object, a As Long, b As Long, kho, dinhmuc, baobi, tong As Double, soluong As Double
Dim T, arr, dk As String
Set dic = CreateObject("scripting.dictionary")
With Sheets("bao_bi")
lr = .Range("A" & Rows.Count).End(xlUp).Row
baobi = .Range("a8:F" & lr).Value
For i = 1 To UBound(baobi)
If Len(baobi(i, 1)) Then
dk = baobi(i, 2) & "BB"
Else
If Not dic.exists(dk) Then
dic.Add dk, i
Else
dic.Item(dk) = dic.Item(dk) & "#" & i
End If
End If
Next i
End With
With Sheets("dinh_muc")
lr = .Range("A" & Rows.Count).End(xlUp).Row
dinhmuc = .Range("a7:D" & lr).Value
For i = 1 To UBound(dinhmuc)
If Len(dinhmuc(i, 1)) Then
dk = dinhmuc(i, 2) & "DM"
Else
If Not dic.exists(dk) Then
dic.Add dk, i
Else
dic.Item(dk) = dic.Item(dk) & "#" & i
End If
End If
Next i
End With
With Sheets("kho")
lr = .Range("B" & Rows.Count).End(xlUp).Row
kho = .Range("B8:G" & lr).Value
For i = 1 To UBound(kho)
dk = kho(i, 1) & "KH"
dic.Item(dk) = kho(i, 5)
Next i
End With
With Sheets("SP xuat")
lr = .Range("A" & Rows.Count).End(xlUp).Row
arr = .Range("A8:F" & lr).Value
ReDim kq(1 To UBound(arr) * 10, 1 To 8)
End With
a = 1
kq(a, 3) = "tong cong"
For i = 1 To UBound(arr)
a = a + 1
b = a
kq(a, 1) = i
kq(a, 2) = arr(i, 2)
kq(a, 3) = arr(i, 3)
kq(a, 4) = arr(i, 5)
kq(a, 7) = arr(i, 6)
dk = kq(a, 2) & "DM"
soluong = kq(a, 4)
kq(1, 7) = kq(1, 7) + kq(a, 7)
If dic.exists(dk) Then
For Each T In Split(dic.Item(dk), "#")
a = a + 1
kq(a, 2) = dinhmuc(T, 2)
kq(a, 3) = dinhmuc(T, 3)
kq(a, 4) = dinhmuc(T, 4) * soluong
dk = kq(a, 2) & "KH"
If dic.exists(dk) Then
kq(a, 5) = dic.Item(dk)
End If
kq(a, 6) = kq(a, 5) * kq(a, 4)
kq(b, 6) = kq(b, 6) + kq(a, 6)
Next
End If
dk = kq(b, 2) & "BB"
If dic.exists(dk) Then
For Each T In Split(dic.Item(dk), "#")
a = a + 1
kq(a, 2) = baobi(T, 2)
kq(a, 3) = baobi(T, 3)
kq(a, 4) = soluong
kq(a, 5) = baobi(T, 5)
kq(a, 6) = kq(a, 4) * kq(a, 5)
kq(b, 6) = kq(b, 6) + kq(a, 6)
Next
End If
kq(1, 6) = kq(1, 6) + kq(b, 6)
kq(b, 8) = kq(b, 6) / kq(b, 7) * 100
Next i
With Sheets("ket_qua")
lr = .Range("b" & Rows.Count).End(xlUp).Row
If lr > 7 Then .Range("a8:H" & lr).ClearContents
.Range("A8:h8").Resize(a).Value = kq
End With
Set dic = Nothing
End Sub
Còn mấy chỗ chưa hoàn chỉnh, ví dụ tính tỷ lệ %, nhưng tôi gửi trước cho bạn xem để test dữ liệu thật. Để hoàn chỉnh còn nhiều việc lắm.Rất cảm ơn Maika8008, file bạn gửi đã đáp ứng được nhu cầu của mình. Nhờ bạn xem lại mã sản phẩm SPH0004 mình sửa kiểu gì cũng không cập nhật giá và thành tiền, đồng thời nhờ Bạn bổ sung thêm dòng Tổng cộng sheet "ket_qua" và giúp mình nội dung sheet "canh_bao" (nãy mình chưa nói đến nên chắc bạn chưa xem đến)
À, tôi không chú ý vụ có 2 dòng bao bì. Để tôi sửa lại 1 chút.Cảm ơn Bạn @Maika8008 và bạn @snow25 rất nhiều, code của 2 bạn đã đáp ứng được yêu cầu của mình, tuy nhiên còn 1 nội dung nhỏ nhờ 2 Bạn xem giúp:
- Code của @Maika8008 đã có thông tin sheet "canh_bao" nhưng chưa copy được 2 dòng bao bì (đối với sản phẩm có 2 loại bao bì);
- Code của @snow25 thì ngược lại đã copy được 2 dòng bao bì (đối với sản phẩm có 2 loại bao bì) nhưng chưa có thông tin sheet "canh_bao";
Nếu được các bạn sửa giúp mình, còn không thì đối với mình như vậy đã là tuyệt lắm rồi.
Bạn thử lại . . .- Code của @Maika8008 đã có thông tin sheet "canh_bao" nhưng chưa copy được 2 dòng bao bì (đối với sản phẩm có 2 loại bao bì);
Nếu được các bạn sửa giúp mình, còn không thì đối với mình như vậy đã là tuyệt lắm rồi.
Cảm ơn Bạn đã góp ý, vì bao bì có nhãn mác tùy theo yêu cầu của từng khách hàng (mỗi nhãn mác có mã số quản lý khác nhau) nên xuất không theo quy luật vì vậy mình phải đưa vào sheet riêng, mục tiêu của mình là copy sang bảng "ket_qua" để tổng hợp giá trị xuất. Một số nội dung mình giải thích chưa rõ mong các bạn thông cảm.Theo tôi nhìn ví dụ ở ket_qua thì thấy cách lấy tin tức không thống nhất: các vật tư được lấy theo từng đơn vị mã hàng (số vật tư nhân cho số lượng thành phẩm; 1 lô thành phẩm 100 chiếc thì lượng vật tư x 100) trong khi bao bì thì lấy cho cả lô thành phẩm (1 lô thành phẩm không cần biết bao nhiêu chiếc, lượng bao bì đã định sẵn).
Vấn đề này để lâu ngày, quên mất luật lấy dữ liệu là sẽ chả còn ai hiểu nổi.
Ít nhất, đầu hoặc cuối bảng phải có dòng giải thích (bảng "ket_qua" đặt tổng lên trên, như vậy chú thích ở trên đầu đúng hơn dưới bảng):
- lượng vật tư được tính theo số lượng hàng
- lượng bao bì được xác định sẵn ở bảng "bao_bi"
Chú:
1. sheet dinh_muc nên kéo lại gần "SP xuat", kế đó đến "bao_bi
2. sheet "SP xuat" nên đặt tên lại là SP_xuat cho đồng tiêu chuẩn đặt tên với mấy sheet khác.
Thì tôi đã nói: cần dòng giải thích trong bảng tổng hợp.Cảm ơn Bạn đã góp ý, vì bao bì có nhãn mác tùy theo yêu cầu của từng khách hàng (mỗi nhãn mác có mã số quản lý khác nhau) nên xuất không theo quy luật vì vậy mình phải đưa vào sheet riêng, mục tiêu của mình là copy sang bảng "ket_qua" để tổng hợp giá trị xuất. Một số nội dung mình giải thích chưa rõ mong các bạn thông cảm.
Code này đã đúng theo nhu cầu của mình, cảm ơn Bạn @Maika8008 rất nhiều!Bạn thử lại . . .
Nhờ Bạn @Maika8008 xem lại code cho mình, khi đưa dữ liệu vào chạy, code copy toàn bộ định mức của các SP vào 1 mã sản phẩm, mình gửi lại file bị lỗi đính kèm, Bạn xem giúp mình nhé, cảm ơn Bạn!Bạn thử lại . . .