Định mức nguyên vật liệu (2 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Tôi tuân thủ nội quy khi đăng bài

nghiemcongdien

Thành viên chính thức
Tham gia
6/10/16
Bài viết
56
Được thích
10
Kính gửi các anh chị diễn đàn
Em có Bảng định mức nguyên vật liệu nhiều cấp (download trên phần mềm xuống) sheet BOM1 A:G em muốn tính toán lại để ra được sheet BOM2, BOM3.
Các anh chị có thể giúp em được không ạ?
Do dữ liệu thực của em có hơn 30.000 dòng dữ liệu nên em mong muốn có những giải pháp tối ưu để có thể cập nhật được thường xuyên ạ.
Em cảm ơn!
 

File đính kèm

Mình không thấy BOM 1 và BOM 2 có sản phẩm trùng Bạn nhỉ.
 
Mình không thấy BOM 1 và BOM 2 có sản phẩm trùng Bạn nhỉ.
Mình cảm ơn bạn đã xem bài viết của mình. Do đợt này bận quá với không thấy bác nào giúp nên mình cũng ít đăng nhập.
Mình đang nhờ thử chat GPT giúp nhưng vẫn chưa ra được kết quả cuối cùng
 
Kính gửi các anh chị
Sau một thời gian nghiên cứu, nhờ Copilot em mới nghiên cứu được code như file đính kèm. Các anh chị giúp em thêm phần code để lặp lại quá trình chèn thêm dòng nếu các dòng mới chèn vấn là Bán thành phẩm ạ.

- Đầu tiên em sẽ phân biệt dựa theo cột A sheet BOM1 để biết đâu là BOM sản phẩm (cấp 1) đâu là BOM BTP.
- Tách ra 2 sheet TP và BTP tương ứng
- Ở sheet TP em tìm ở cột D xem mã vật tư nào là Bán thành phẩm thì lấy dữ liệu ở sheet BTP để thêm vào
- Nếu dòng mới thêm vào vẫn có mã vật tư là Bán thành phẩm thì tiếp tục chèn tiếp đến khi nào không xuất hiện nữa thì thôi (em đang gặp khó ở bước này đối với VBA cho Excel còn Java Script cho google sheet đã chạy tốt, tuy nhiên dữ liệu của em rất lớn nên thời gian chạy trên google sheet không đủ - chỉ cho chạy tối đa 6p).
Em gửi cả 2 loại code kính mong các bác giúp đỡ em với ạ.

VBA:
Sub InsertRowsForBTPWithDataAndCalculate()
Dim wsTP As Worksheet
Dim wsBTP As Worksheet
Dim tpData As Variant
Dim btpData As Variant
Dim btpCount As Object
Dim lastRowTP As Long
Dim i As Long, j As Long, k As Long
Dim maVatTu As String
Dim numRowsToInsert As Long
Dim startRow As Long
Dim quantity As Double
Dim newBTPFound As Boolean

' Ð?t worksheet c?n làm vi?c
On Error Resume Next
Set wsTP = ThisWorkbook.Sheets("TP")
Set wsBTP = ThisWorkbook.Sheets("BTP")
On Error GoTo 0

' Ki?m tra n?u sheets không t?n t?i
If wsTP Is Nothing Or wsBTP Is Nothing Then
MsgBox "Ki?m tra tên sheet, có th? không t?n t?i: TP ho?c BTP.", vbExclamation
Exit Sub
End If

' L?y d? li?u t? sheet TP
tpData = wsTP.UsedRange.Value

' L?y d? li?u t? sheet BTP
btpData = wsBTP.UsedRange.Value

' T?o d?i tu?ng Dictionary d? luu s? l?n xu?t hi?n c?a m?i mã s?n ph?m trong BTP
Set btpCount = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(btpData, 1)
maVatTu = btpData(i, 1)
If Not btpCount.exists(maVatTu) Then
btpCount.Add maVatTu, 1
Else
btpCount(maVatTu) = btpCount(maVatTu) + 1
End If
Next i

' Xác d?nh dòng cu?i cùng có d? li?u trong sheet TP
lastRowTP = wsTP.Cells(wsTP.Rows.Count, "A").End(xlUp).Row

' Duy?t qua các dòng t? cu?i lên d?u d? chèn các dòng m?i du?i m?i ô ? c?t I có giá tr? là BTP
For i = lastRowTP To 2 Step -1
maVatTu = wsTP.Cells(i, 4).Value ' Mã v?t tu c?t D
If btpCount.exists(maVatTu) Then ' Ki?m tra n?u mã v?t tu xu?t hi?n trong BTP
wsTP.Cells(i, 9).Value = "BTP" ' Ð?t giá tr? "BTP" vào c?t I
numRowsToInsert = btpCount(maVatTu)
wsTP.Cells(i, 10).Value = numRowsToInsert ' Ð?t s? dòng c?n chèn vào c?t J
If numRowsToInsert > 0 Then
startRow = i + 1
wsTP.Rows(startRow & ":" & startRow + numRowsToInsert - 1).Insert Shift:=xlDown
' Tìm t?t c? các hàng tuong ?ng trong BTP và chèn vào TP
For k = 2 To UBound(btpData, 1)
If btpData(k, 1) = maVatTu Then
' Ði?n d? li?u vào dòng m?i
wsTP.Cells(startRow, 1).Value = wsTP.Cells(i, 1).Value ' Mã s?n ph?m
wsTP.Cells(startRow, 2).Value = wsTP.Cells(i, 2).Value ' S?n ph?m
wsTP.Cells(startRow, 3).Value = wsTP.Cells(i, 3).Value ' ÐVT
wsTP.Cells(startRow, 4).Value = btpData(k, 4) ' Mã v?t tu
wsTP.Cells(startRow, 5).Value = btpData(k, 5) ' V?t tu
wsTP.Cells(startRow, 6).Value = btpData(k, 6) ' ÐVT v?t tu
wsTP.Cells(startRow, 7).Value = btpData(k, 7) ' Lo?i d?nh m?c

' Tính s? lu?ng m?i ? c?t H
quantity = wsTP.Cells(i, 8).Value * btpData(k, 8)
wsTP.Cells(startRow, 8).Value = quantity

' Ki?m tra và d?t giá tr? cho c?t I (Lo?i) và c?t J (S? dòng) c?a dòng m?i
If btpCount.exists(btpData(k, 4)) Then
wsTP.Cells(startRow, 9).Value = "BTP"
wsTP.Cells(startRow, 10).Value = btpCount(btpData(k, 4))
End If

wsTP.Rows(startRow).Interior.Color = RGB(255, 255, 0) ' Ð?t màu n?n cho dòng m?i (vàng)
startRow = startRow + 1
End If
Next k
End If
End If
Next i

MsgBox "Hoàn t?t chèn các dòng du?i các ô có giá tr? là BTP v?i n?i dung tuong ?ng và tính toán s? lu?ng."
End Sub

Java Script
function insertBTPRowsIntoTP() {
var tpSheet = SpreadsheetApp.getActiveSpreadsheet().getSheetByName("TP"); // Thay "TP" bằng tên sheet của bạn
var btpSheet = SpreadsheetApp.getActiveSpreadsheet().getSheetByName("BTP");
// Lấy dữ liệu từ sheet TP
var tpData = tpSheet.getDataRange().getValues();

// Lấy dữ liệu từ sheet BTP
var btpData = btpSheet.getDataRange().getValues();

// Tạo một đối tượng để lưu số lần xuất hiện của mỗi mã linh kiện trong BTP
var btpMap = {};
for (var i = 1; i < btpData.length; i++) { // Bắt đầu từ 1 để bỏ qua tiêu đề
var maLinhKien = btpData[0];
if (!btpMap[maLinhKien]) {
btpMap[maLinhKien] = [];
}
btpMap[maLinhKien].push({
rowData: btpData.slice(3, 7), // Lưu dữ liệu từ cột D đến G
quantity: btpData[7] // Lưu số lượng
});
}
// Hàm đệ quy để chèn các dòng BTP và bổ sung ô trống
function insertRows(sheet, startRow, maLinhKienTP, quantityMultiplier, maSanPhamTP, tenSanPhamTP, donViTinhTP) {
if (!btpMap[maLinhKienTP]) return; // Nếu không có mã linh kiện trong BTP thì dừng lại
var numRowsToInsert = btpMap[maLinhKienTP].length;
for (var j = 0; j < numRowsToInsert; j++) {
sheet.insertRowAfter(startRow);
var newRow = [maSanPhamTP, tenSanPhamTP, donViTinhTP].concat(btpMap[maLinhKienTP][j].rowData).concat(quantityMultiplier * btpMap[maLinhKienTP][j].quantity);
var newRange = sheet.getRange(startRow + 1, 1, 1, 8); // Cột A đến H
newRange.setValues([newRow]); // Chèn dữ liệu vào từ cột A đến H
newRange.setBackground('#FFFF00'); // Đặt màu nền cho dòng mới (vàng)
startRow++;
// Kiểm tra mã linh kiện trong các dòng vừa chèn xem có là BTP không
var nestedMaLinhKienTP = newRow[3]; // Mã linh kiện mới (cột D)
var nestedQuantity = quantityMultiplier * btpMap[maLinhKienTP][j].quantity;
insertRows(sheet, startRow, nestedMaLinhKienTP, nestedQuantity, newRow[0], newRow[1], newRow[2]);
}
}
// Duyệt qua sheet TP để chèn các dòng từ BTP
for (var i = tpData.length - 1; i >= 1; i--) { // Bắt đầu từ cuối để tránh xung đột khi chèn
var maLinhKienTP = tpData[3]; // Mã linh kiện cột D
var tpQuantity = tpData[7]; // Số lượng cột H
var maSanPhamTP = tpData[0]; // Mã sản phẩm cột A
var tenSanPhamTP = tpData[1]; // Tên sản phẩm cột B
var donViTinhTP = tpData[2]; // Đơn vị tính cột C
insertRows(tpSheet, i, maLinhKienTP, tpQuantity, maSanPhamTP, tenSanPhamTP, donViTinhTP);
}
}
Do file google sheet hôm trước em gửi ở dạng excel nên em gửi lại ạ
 

File đính kèm

Lần chỉnh sửa cuối:
Kính gửi các anh chị diễn đàn
Em có Bảng định mức nguyên vật liệu nhiều cấp (download trên phần mềm xuống) sheet BOM1 A:G em muốn tính toán lại để ra được sheet BOM2, BOM3.
Các anh chị có thể giúp em được không ạ?
Do dữ liệu thực của em có hơn 30.000 dòng dữ liệu nên em mong muốn có những giải pháp tối ưu để có thể cập nhật được thường xuyên ạ.
Em cảm ơn!
Bạn xem thế này đúng ý chưa.
---

Sorry, mình hiểu sai ý bạn, đọc thêm bài #4 mới hiểu ý.
 

File đính kèm

Lần chỉnh sửa cuối:
Bạn xem thế này đúng ý chưa.
---

Sorry, mình hiểu sai ý bạn, đọc thêm bài #4 mới hiểu ý.
Cảm ơn bạn đã xem bài viết của mình. Vì trên excel chưa chạy ra kết quả lên mình làm để kết quả trên file google sheet bạn ạ.
Sau khi chèn được hết các mã bán thành phẩm (bom cấp) vào theo mã thành phẩm thì mình pivot tab là ra kết quả thôi.
1732355919025.png
 
Kính gửi các anh chị
Sau một thời gian nghiên cứu, nhờ Copilot em mới nghiên cứu được code như file đính kèm. Các anh chị giúp em thêm phần code để lặp lại quá trình chèn thêm dòng nếu các dòng mới chèn vấn là Bán thành phẩm ạ.

- Đầu tiên em sẽ phân biệt dựa theo cột A sheet BOM1 để biết đâu là BOM sản phẩm (cấp 1) đâu là BOM BTP.
- Tách ra 2 sheet TP và BTP tương ứng
- Ở sheet TP em tìm ở cột D xem mã vật tư nào là Bán thành phẩm thì lấy dữ liệu ở sheet BTP để thêm vào
- Nếu dòng mới thêm vào vẫn có mã vật tư là Bán thành phẩm thì tiếp tục chèn tiếp đến khi nào không xuất hiện nữa thì thôi (em đang gặp khó ở bước này đối với VBA cho Excel còn Java Script cho google sheet đã chạy tốt, tuy nhiên dữ liệu của em rất lớn nên thời gian chạy trên google sheet không đủ - chỉ cho chạy tối đa 6p).
Em gửi cả 2 loại code kính mong các bác giúp đỡ em với ạ.

VBA:
Sub InsertRowsForBTPWithDataAndCalculate()
Dim wsTP As Worksheet
Dim wsBTP As Worksheet
Dim tpData As Variant
Dim btpData As Variant
Dim btpCount As Object
Dim lastRowTP As Long
Dim i As Long, j As Long, k As Long
Dim maVatTu As String
Dim numRowsToInsert As Long
Dim startRow As Long
Dim quantity As Double
Dim newBTPFound As Boolean

' Ð?t worksheet c?n làm vi?c
On Error Resume Next
Set wsTP = ThisWorkbook.Sheets("TP")
Set wsBTP = ThisWorkbook.Sheets("BTP")
On Error GoTo 0

' Ki?m tra n?u sheets không t?n t?i
If wsTP Is Nothing Or wsBTP Is Nothing Then
MsgBox "Ki?m tra tên sheet, có th? không t?n t?i: TP ho?c BTP.", vbExclamation
Exit Sub
End If

' L?y d? li?u t? sheet TP
tpData = wsTP.UsedRange.Value

' L?y d? li?u t? sheet BTP
btpData = wsBTP.UsedRange.Value

' T?o d?i tu?ng Dictionary d? luu s? l?n xu?t hi?n c?a m?i mã s?n ph?m trong BTP
Set btpCount = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(btpData, 1)
maVatTu = btpData(i, 1)
If Not btpCount.exists(maVatTu) Then
btpCount.Add maVatTu, 1
Else
btpCount(maVatTu) = btpCount(maVatTu) + 1
End If
Next i

' Xác d?nh dòng cu?i cùng có d? li?u trong sheet TP
lastRowTP = wsTP.Cells(wsTP.Rows.Count, "A").End(xlUp).Row

' Duy?t qua các dòng t? cu?i lên d?u d? chèn các dòng m?i du?i m?i ô ? c?t I có giá tr? là BTP
For i = lastRowTP To 2 Step -1
maVatTu = wsTP.Cells(i, 4).Value ' Mã v?t tu c?t D
If btpCount.exists(maVatTu) Then ' Ki?m tra n?u mã v?t tu xu?t hi?n trong BTP
wsTP.Cells(i, 9).Value = "BTP" ' Ð?t giá tr? "BTP" vào c?t I
numRowsToInsert = btpCount(maVatTu)
wsTP.Cells(i, 10).Value = numRowsToInsert ' Ð?t s? dòng c?n chèn vào c?t J
If numRowsToInsert > 0 Then
startRow = i + 1
wsTP.Rows(startRow & ":" & startRow + numRowsToInsert - 1).Insert Shift:=xlDown
' Tìm t?t c? các hàng tuong ?ng trong BTP và chèn vào TP
For k = 2 To UBound(btpData, 1)
If btpData(k, 1) = maVatTu Then
' Ði?n d? li?u vào dòng m?i
wsTP.Cells(startRow, 1).Value = wsTP.Cells(i, 1).Value ' Mã s?n ph?m
wsTP.Cells(startRow, 2).Value = wsTP.Cells(i, 2).Value ' S?n ph?m
wsTP.Cells(startRow, 3).Value = wsTP.Cells(i, 3).Value ' ÐVT
wsTP.Cells(startRow, 4).Value = btpData(k, 4) ' Mã v?t tu
wsTP.Cells(startRow, 5).Value = btpData(k, 5) ' V?t tu
wsTP.Cells(startRow, 6).Value = btpData(k, 6) ' ÐVT v?t tu
wsTP.Cells(startRow, 7).Value = btpData(k, 7) ' Lo?i d?nh m?c

' Tính s? lu?ng m?i ? c?t H
quantity = wsTP.Cells(i, 8).Value * btpData(k, 8)
wsTP.Cells(startRow, 8).Value = quantity

' Ki?m tra và d?t giá tr? cho c?t I (Lo?i) và c?t J (S? dòng) c?a dòng m?i
If btpCount.exists(btpData(k, 4)) Then
wsTP.Cells(startRow, 9).Value = "BTP"
wsTP.Cells(startRow, 10).Value = btpCount(btpData(k, 4))
End If

wsTP.Rows(startRow).Interior.Color = RGB(255, 255, 0) ' Ð?t màu n?n cho dòng m?i (vàng)
startRow = startRow + 1
End If
Next k
End If
End If
Next i

MsgBox "Hoàn t?t chèn các dòng du?i các ô có giá tr? là BTP v?i n?i dung tuong ?ng và tính toán s? lu?ng."
End Sub

Java Script
function insertBTPRowsIntoTP() {
var tpSheet = SpreadsheetApp.getActiveSpreadsheet().getSheetByName("TP"); // Thay "TP" bằng tên sheet của bạn
var btpSheet = SpreadsheetApp.getActiveSpreadsheet().getSheetByName("BTP");
// Lấy dữ liệu từ sheet TP
var tpData = tpSheet.getDataRange().getValues();

// Lấy dữ liệu từ sheet BTP
var btpData = btpSheet.getDataRange().getValues();

// Tạo một đối tượng để lưu số lần xuất hiện của mỗi mã linh kiện trong BTP
var btpMap = {};
for (var i = 1; i < btpData.length; i++) { // Bắt đầu từ 1 để bỏ qua tiêu đề
var maLinhKien = btpData[0];
if (!btpMap[maLinhKien]) {
btpMap[maLinhKien] = [];
}
btpMap[maLinhKien].push({
rowData: btpData.slice(3, 7), // Lưu dữ liệu từ cột D đến G
quantity: btpData[7] // Lưu số lượng
});
}
// Hàm đệ quy để chèn các dòng BTP và bổ sung ô trống
function insertRows(sheet, startRow, maLinhKienTP, quantityMultiplier, maSanPhamTP, tenSanPhamTP, donViTinhTP) {
if (!btpMap[maLinhKienTP]) return; // Nếu không có mã linh kiện trong BTP thì dừng lại
var numRowsToInsert = btpMap[maLinhKienTP].length;
for (var j = 0; j < numRowsToInsert; j++) {
sheet.insertRowAfter(startRow);
var newRow = [maSanPhamTP, tenSanPhamTP, donViTinhTP].concat(btpMap[maLinhKienTP][j].rowData).concat(quantityMultiplier * btpMap[maLinhKienTP][j].quantity);
var newRange = sheet.getRange(startRow + 1, 1, 1, 8); // Cột A đến H
newRange.setValues([newRow]); // Chèn dữ liệu vào từ cột A đến H
newRange.setBackground('#FFFF00'); // Đặt màu nền cho dòng mới (vàng)
startRow++;
// Kiểm tra mã linh kiện trong các dòng vừa chèn xem có là BTP không
var nestedMaLinhKienTP = newRow[3]; // Mã linh kiện mới (cột D)
var nestedQuantity = quantityMultiplier * btpMap[maLinhKienTP][j].quantity;
insertRows(sheet, startRow, nestedMaLinhKienTP, nestedQuantity, newRow[0], newRow[1], newRow[2]);
}
}
// Duyệt qua sheet TP để chèn các dòng từ BTP
for (var i = tpData.length - 1; i >= 1; i--) { // Bắt đầu từ cuối để tránh xung đột khi chèn
var maLinhKienTP = tpData[3]; // Mã linh kiện cột D
var tpQuantity = tpData[7]; // Số lượng cột H
var maSanPhamTP = tpData[0]; // Mã sản phẩm cột A
var tenSanPhamTP = tpData[1]; // Tên sản phẩm cột B
var donViTinhTP = tpData[2]; // Đơn vị tính cột C
insertRows(tpSheet, i, maLinhKienTP, tpQuantity, maSanPhamTP, tenSanPhamTP, donViTinhTP);
}
}
Do file google sheet hôm trước em gửi ở dạng excel nên em gửi lại ạ
Dữ liệu chỉ có 3 cấp hay nhiều hơn?
 
Dữ liệu nhà em đã đến cấp 4,5 rồi ạ. Cả BOM TP và BTP đã hơn 30.000 dòng chưa kể rất nhiều TP dùng chung BTP nên file rất nặng, mong bác giúp cho giải pháp tối ưu ạ
Chạy code VBA . . .
Mã:
Option Explicit

Sub xyz()
  Dim arr(), bom(), bom2(), aTD()
  Dim dSP As Object, d As Object, d1 As Object, d2 As Object, d3 As Object
  Dim sR&, sC&, i&, r2&, r3&, k&, c&, key$
 
  Set dSP = CreateObject("scripting.dictionary")
  Set d = CreateObject("scripting.dictionary")
  Set d1 = CreateObject("scripting.dictionary")
  Set d2 = CreateObject("scripting.dictionary")
  Set d3 = CreateObject("scripting.dictionary")
  With Sheets("BOM1")
    arr = .Range("A2", .Range("I" & Rows.Count).End(xlUp)).Value
  End With
  sR = UBound(arr)
  c = 3
  ReDim aTD(1 To 2, 1 + c To 3 + c)
  For i = 1 To sR
    If dSP.exists(arr(i, 9)) = False Then
      c = c + 1
      dSP(arr(i, 9)) = c
      aTD(1, c) = arr(i, 9)
      aTD(2, c) = arr(i, 1)
    End If
    d(arr(i, 4)) = ""
    d1(arr(i, 1)) = ""
  Next i
  ReDim bom3(1 To sR, 1 To c)
  ReDim bom2(1 To sR, 1 To c)
  For i = 1 To sR
    c = dSP(arr(i, 9))
    If d2.exists(arr(i, 4)) = False Then
      r2 = r2 + 1
      d2(arr(i, 4)) = r2
      k = r2
    Else
      k = d2(arr(i, 4))
    End If
    bom2(k, 1) = arr(i, 4)
    bom2(k, 2) = arr(i, 5)
    bom2(k, 3) = arr(i, 6)
    bom2(k, c) = bom2(k, c) + arr(i, 7)
    If d.exists(arr(i, 1)) = False Or d1.exists(arr(i, 4)) = False Then
      If d3.exists(arr(i, 4)) = False Then
        r3 = r3 + 1
        d3(arr(i, 4)) = r3
        k = r3
      Else
        k = d3(arr(i, 4))
      End If
      bom3(k, 1) = arr(i, 4)
      bom3(k, 2) = arr(i, 5)
      bom3(k, 3) = arr(i, 6)
      bom3(k, c) = bom3(k, c) + arr(i, 7)
    End If
  Next i
  Sheets("BOM2").Range("D2").Resize(2, UBound(aTD, 2) - 3) = aTD
  Sheets("BOM2").Range("A4").Resize(r2, UBound(bom2, 2)) = bom2
  Sheets("BOM3").Range("D2").Resize(2, UBound(aTD, 2) - 3) = aTD
  Sheets("BOM3").Range("A4").Resize(r3, UBound(bom2, 2)) = bom3
End Sub
 
Chạy code VBA . . .
Mã:
Option Explicit

Sub xyz()
  Dim arr(), bom(), bom2(), aTD()
  Dim dSP As Object, d As Object, d1 As Object, d2 As Object, d3 As Object
  Dim sR&, sC&, i&, r2&, r3&, k&, c&, key$
 
  Set dSP = CreateObject("scripting.dictionary")
  Set d = CreateObject("scripting.dictionary")
  Set d1 = CreateObject("scripting.dictionary")
  Set d2 = CreateObject("scripting.dictionary")
  Set d3 = CreateObject("scripting.dictionary")
  With Sheets("BOM1")
    arr = .Range("A2", .Range("I" & Rows.Count).End(xlUp)).Value
  End With
  sR = UBound(arr)
  c = 3
  ReDim aTD(1 To 2, 1 + c To 3 + c)
  For i = 1 To sR
    If dSP.exists(arr(i, 9)) = False Then
      c = c + 1
      dSP(arr(i, 9)) = c
      aTD(1, c) = arr(i, 9)
      aTD(2, c) = arr(i, 1)
    End If
    d(arr(i, 4)) = ""
    d1(arr(i, 1)) = ""
  Next i
  ReDim bom3(1 To sR, 1 To c)
  ReDim bom2(1 To sR, 1 To c)
  For i = 1 To sR
    c = dSP(arr(i, 9))
    If d2.exists(arr(i, 4)) = False Then
      r2 = r2 + 1
      d2(arr(i, 4)) = r2
      k = r2
    Else
      k = d2(arr(i, 4))
    End If
    bom2(k, 1) = arr(i, 4)
    bom2(k, 2) = arr(i, 5)
    bom2(k, 3) = arr(i, 6)
    bom2(k, c) = bom2(k, c) + arr(i, 7)
    If d.exists(arr(i, 1)) = False Or d1.exists(arr(i, 4)) = False Then
      If d3.exists(arr(i, 4)) = False Then
        r3 = r3 + 1
        d3(arr(i, 4)) = r3
        k = r3
      Else
        k = d3(arr(i, 4))
      End If
      bom3(k, 1) = arr(i, 4)
      bom3(k, 2) = arr(i, 5)
      bom3(k, 3) = arr(i, 6)
      bom3(k, c) = bom3(k, c) + arr(i, 7)
    End If
  Next i
  Sheets("BOM2").Range("D2").Resize(2, UBound(aTD, 2) - 3) = aTD
  Sheets("BOM2").Range("A4").Resize(r2, UBound(bom2, 2)) = bom2
  Sheets("BOM3").Range("D2").Resize(2, UBound(aTD, 2) - 3) = aTD
  Sheets("BOM3").Range("A4").Resize(r3, UBound(bom2, 2)) = bom3
End Sub
Em cảm ơn ạ. Để em test thử ạ
 
Chạy code VBA . . .
Mã:
Option Explicit

Sub xyz()
  Dim arr(), bom(), bom2(), aTD()
  Dim dSP As Object, d As Object, d1 As Object, d2 As Object, d3 As Object
  Dim sR&, sC&, i&, r2&, r3&, k&, c&, key$
 
  Set dSP = CreateObject("scripting.dictionary")
  Set d = CreateObject("scripting.dictionary")
  Set d1 = CreateObject("scripting.dictionary")
  Set d2 = CreateObject("scripting.dictionary")
  Set d3 = CreateObject("scripting.dictionary")
  With Sheets("BOM1")
    arr = .Range("A2", .Range("I" & Rows.Count).End(xlUp)).Value
  End With
  sR = UBound(arr)
  c = 3
  ReDim aTD(1 To 2, 1 + c To 3 + c)
  For i = 1 To sR
    If dSP.exists(arr(i, 9)) = False Then
      c = c + 1
      dSP(arr(i, 9)) = c
      aTD(1, c) = arr(i, 9)
      aTD(2, c) = arr(i, 1)
    End If
    d(arr(i, 4)) = ""
    d1(arr(i, 1)) = ""
  Next i
  ReDim bom3(1 To sR, 1 To c)
  ReDim bom2(1 To sR, 1 To c)
  For i = 1 To sR
    c = dSP(arr(i, 9))
    If d2.exists(arr(i, 4)) = False Then
      r2 = r2 + 1
      d2(arr(i, 4)) = r2
      k = r2
    Else
      k = d2(arr(i, 4))
    End If
    bom2(k, 1) = arr(i, 4)
    bom2(k, 2) = arr(i, 5)
    bom2(k, 3) = arr(i, 6)
    bom2(k, c) = bom2(k, c) + arr(i, 7)
    If d.exists(arr(i, 1)) = False Or d1.exists(arr(i, 4)) = False Then
      If d3.exists(arr(i, 4)) = False Then
        r3 = r3 + 1
        d3(arr(i, 4)) = r3
        k = r3
      Else
        k = d3(arr(i, 4))
      End If
      bom3(k, 1) = arr(i, 4)
      bom3(k, 2) = arr(i, 5)
      bom3(k, 3) = arr(i, 6)
      bom3(k, c) = bom3(k, c) + arr(i, 7)
    End If
  Next i
  Sheets("BOM2").Range("D2").Resize(2, UBound(aTD, 2) - 3) = aTD
  Sheets("BOM2").Range("A4").Resize(r2, UBound(bom2, 2)) = bom2
  Sheets("BOM3").Range("D2").Resize(2, UBound(aTD, 2) - 3) = aTD
  Sheets("BOM3").Range("A4").Resize(r3, UBound(bom2, 2)) = bom3
End Sub
Em cảm ơn bác. Đúng như kết quả em mong muốn rồi, tuy nhiên trong bài 1 em quên chưa ghi là dữ liệu gốc của em chỉ có từ cột A đến cột G còn phần em bôi vàng từ cột H đến cột J là em điền tay vào ạ. Nên khi em thay dữ liệu gốc vào vẫn chưa đủ dữ liệu để chạy được ạ. Bác giúp em nốt mấy cột H đến J được không ạ. Hay hàm của bác chỉ cần chạy từ cột A đến G mà vẫn ra được kết quả thì tốt quá ạ.
 
Em cảm ơn bác. Đúng như kết quả em mong muốn rồi, tuy nhiên trong bài 1 em quên chưa ghi là dữ liệu gốc của em chỉ có từ cột A đến cột G còn phần em bôi vàng từ cột H đến cột J là em điền tay vào ạ. Nên khi em thay dữ liệu gốc vào vẫn chưa đủ dữ liệu để chạy được ạ. Bác giúp em nốt mấy cột H đến J được không ạ. Hay hàm của bác chỉ cần chạy từ cột A đến G mà vẫn ra được kết quả thì tốt quá ạ.
Dòng 33 không có dũ liệu để nhận diện của sản phẩm nào, làm sao biết là của tủ C?
 
Dòng 33 không có dũ liệu để nhận diện của sản phẩm nào, làm sao biết là của tủ C?
Dòng 33 là ăn theo thông tin dòng 29 bác ạ
SPW4400300200Cụm vỏ tủ CCáiSPW4400300700Hồi tủ
SPW4400300700Hồi tủCáiSPW4400101100Thép tấm
Chỉ có dòng 26 em kéo công thức bị sai, mã đúng phải là SPW4400101000 chứ không phải là SPW4400100901 ạ
 
Dòng 33 là ăn theo thông tin dòng 29 bác ạ
SPW4400300200Cụm vỏ tủ CCáiSPW4400300700Hồi tủ
SPW4400300700Hồi tủCáiSPW4400101100Thép tấm
Chỉ có dòng 26 em kéo công thức bị sai, mã đúng phải là SPW4400101000 chứ không phải là SPW4400100901 ạ
Mã Vật tư có 3 ký đầu luôn là "SPW" ?
Bạn tính tay lại thật chính xác dòng kết quả của "Thép tấm " để mình tính lại cột số lượng
 
Mã Vật tư có 3 ký đầu luôn là "SPW" ?
Bạn tính tay lại thật chính xác dòng kết quả của "Thép tấm " để mình tính lại cột số lượng
Mã vật tư nhà em nó cũng có nhiều dạng ạ. Cột thép tấm em điền vào đúng rồi ạ: Tủ A = Tủ B = 8,7 Tủ C = 7 ạ.
Ở bài 4 em có giải thích nhiều hơn ạ. Cột A bao gồm thành phẩm và bán thành phẩm (TP) còn cột D bao gồm bán thành phẩm (BTP) và nguyên vật liệu (NVL) ạ. Để phân biệt TP và BTP thì kiểm tra ở cột A xem có xuất hiện ở cột D không, nếu có thì nó là BTP còn không thì là NVL ạ, để phân biệt BTP và NVL ở cột D cũng tương tự như vậy ạ.
Như ở bài 4 em có trình bày, em phân biệt BOM TP riêng và BOM BTP riêng, sau đó sẽ chèn BOM BTP vào BOM TP cho đến khi các dòng được chèn thêm vào nó không xuất hiện BTP nữa thì thôi ạ. Bác xem làm theo hướng này có được không ạ.
 
Cũng liên quan đến vấn đề tương tự như thế này, nhờ các cao nhân chỉ giúp file này với ạ.
Sheet DATA của bên em cũng có khoảng hơn 30k dòng. Cột A là mã thành phẩm hoặc bán thành phẩm. Cột D là mã vật tư hoặc mã bán thành phẩm.
Cột G là số lượng Bán thành phẩm hoặc linh kiện ở cột D dùng để cấu thành lên thành phẩm hoặc bán thành phẩm ở Cột A.
Có mốt số mã có cả ở cột A và cột D vì nó là bán thành phẩm: ở cột G thì đóng vai trò là NVL của thành phẩm cột A. Ở cột A thì đóng vai trò là thành phẩm mẹ của các loại NVL riêng ở cột D.
File 2024.11.25 BOM Copy là data gốc.

Giờ em muốn tạo Code VBA để tạo ra 1 BOM của tất cả các loại thành phẩm và bán thành phẩm, trong đó BOM thành phẩm chỉ thể hiện những loại NVL cuối cùng ở Level thấp nhất. nghĩa là sẽ tự Breakdown BOM BTP ra thành các NVL nhỏ hơn, sau đó tổng hợp lại từng loại NVL nhỏ trong BOM thành phẩm.


Mục đích là để mình dùng để tạo file Order NVL cho SX.

Mình xin gửi file ở đây nhờ các cao nhân xử lý giúp nhé.
Mình gửi kèm 2 file. 1 file là file Demo cho data nhỏ, 1 file là hiện trạng của mình. Các cao nhân nào giúp được thì chia sẻ/inbox mình nhé. Cảm ơn cả nhà.
 

File đính kèm

Mã vật tư nhà em nó cũng có nhiều dạng ạ. Cột thép tấm em điền vào đúng rồi ạ: Tủ A = Tủ B = 8,7 Tủ C = 7 ạ.
Ở bài 4 em có giải thích nhiều hơn ạ. Cột A bao gồm thành phẩm và bán thành phẩm (TP) còn cột D bao gồm bán thành phẩm (BTP) và nguyên vật liệu (NVL) ạ. Để phân biệt TP và BTP thì kiểm tra ở cột A xem có xuất hiện ở cột D không, nếu có thì nó là BTP còn không thì là NVL ạ, để phân biệt BTP và NVL ở cột D cũng tương tự như vậy ạ.
Như ở bài 4 em có trình bày, em phân biệt BOM TP riêng và BOM BTP riêng, sau đó sẽ chèn BOM BTP vào BOM TP cho đến khi các dòng được chèn thêm vào nó không xuất hiện BTP nữa thì thôi ạ. Bác xem làm theo hướng này có được không ạ.
Kiểm tra lại . . .
Mã:
Option Explicit

Sub xyz()
  Dim arr(), bom2(), bom3(), aTD(), a
  Dim dSP As Object, d As Object, d2 As Object, b2 As Object, b3 As Object
  Dim sR&, sC&, i&, r2&, r3&, k&, c&, j&, vt$

  Set d = CreateObject("scripting.dictionary")
  Set d2 = CreateObject("scripting.dictionary")
  Set dSP = CreateObject("scripting.dictionary")
  Set b2 = CreateObject("scripting.dictionary")
  Set b3 = CreateObject("scripting.dictionary")
 
  aTD = Sheets("BOM2").Range("A2:C3").Value 'Mang dong tieu de
  sC = UBound(aTD, 2) 'So cot tieu de thong tin vat tu
  With Sheets("BOM1")
    arr = .Range("A2", .Range("G" & Rows.Count).End(xlUp)).Value
  End With
  sR = UBound(arr)
 
  For i = 1 To sR
    d(arr(i, 1)) = d(arr(i, 1)) & "," & i
    d2(arr(i, 4)) = ""
  Next i
  For i = 1 To sR 'Loc San Pham
    If d2.exists(arr(i, 1)) = False Then
      If dSP.exists(arr(i, 1)) = False Then
        sC = sC + 1
        dSP(arr(i, 1)) = sC
        ReDim Preserve aTD(1 To 2, 1 To sC)
        aTD(1, sC) = arr(i, 2)
        aTD(2, sC) = arr(i, 1)
      End If
    End If
  Next
  ReDim bom2(1 To sR, 1 To sC)
  ReDim bom3(1 To sR, 1 To sC)
 
  For c = 4 To sC
    a = Split(d(aTD(2, c)), ",")
    For j = 1 To UBound(a)
      i = CLng(a(j))
      vt = arr(i, 4)
      If b2.exists(vt) = False Then
        r2 = r2 + 1
        b2(vt) = r2
      End If
      k = b2(vt)
      bom2(k, 1) = arr(i, 4):      bom2(k, 2) = arr(i, 5)
      bom2(k, 3) = arr(i, 6):      bom2(k, c) = bom2(k, c) + arr(i, 7)

      If b3.exists(vt) = False Then
        r3 = r3 + 1
        b3(vt) = r3
      End If
      k = b3(vt)
      bom3(k, 1) = arr(i, 4):      bom3(k, 2) = arr(i, 5)
      bom3(k, 3) = arr(i, 6):      bom3(k, c) = bom3(k, c) + arr(i, 7)
      If d.exists(vt) Then
        Call DeQui(arr, bom2, bom3, d, b2, b3, r2, r3, c, Split(d(vt), ","), arr(i, 7))
      End If
    Next j
  Next c
  Sheets("BOM2").Range("A2").Resize(2, sC) = aTD
  Sheets("BOM2").Range("A4").Resize(r2, sC) = bom2
  Sheets("BOM3").Range("A2").Resize(2, sC) = aTD
  Sheets("BOM3").Range("A4").Resize(r3, sC) = bom3
End Sub

Sub DeQui(arr, bom2, bom3, d, b2, b3, r2, r3, c, ByVal a, ByVal sl#)
  Dim vt$, j&, i&, k&
    For j = 1 To UBound(a)
      i = CLng(a(j))
      vt = arr(i, 4)
      If b2.exists(vt) = False Then
        r2 = r2 + 1
        b2(vt) = r2
      End If
      k = b2(vt)
      bom2(k, 1) = arr(i, 4):      bom2(k, 2) = arr(i, 5)
      bom2(k, 3) = arr(i, 6):      bom2(k, c) = bom2(k, c) + arr(i, 7) * sl

      If d.exists(vt) Then
        Call DeQui(arr, bom2, bom3, d, b2, b3, r2, r3, c, Split(d(vt), ","), arr(i, 7) * sl)
      Else
        If b3.exists(vt) = False Then
          r3 = r3 + 1
          b3(vt) = r3
        End If
        k = b3(vt)
        bom3(k, 1) = arr(i, 4):      bom3(k, 2) = arr(i, 5)
        bom3(k, 3) = arr(i, 6):      bom3(k, c) = bom3(k, c) + arr(i, 7) * sl
      End If
    Next j
End Sub
 
Cũng liên quan đến vấn đề tương tự như thế này, nhờ các cao nhân chỉ giúp file này với ạ.
Sheet DATA của bên em cũng có khoảng hơn 30k dòng. Cột A là mã thành phẩm hoặc bán thành phẩm. Cột D là mã vật tư hoặc mã bán thành phẩm.
Cột G là số lượng Bán thành phẩm hoặc linh kiện ở cột D dùng để cấu thành lên thành phẩm hoặc bán thành phẩm ở Cột A.
Có mốt số mã có cả ở cột A và cột D vì nó là bán thành phẩm: ở cột G thì đóng vai trò là NVL của thành phẩm cột A. Ở cột A thì đóng vai trò là thành phẩm mẹ của các loại NVL riêng ở cột D.
File 2024.11.25 BOM Copy là data gốc.

Giờ em muốn tạo Code VBA để tạo ra 1 BOM của tất cả các loại thành phẩm và bán thành phẩm, trong đó BOM thành phẩm chỉ thể hiện những loại NVL cuối cùng ở Level thấp nhất. nghĩa là sẽ tự Breakdown BOM BTP ra thành các NVL nhỏ hơn, sau đó tổng hợp lại từng loại NVL nhỏ trong BOM thành phẩm.


Mục đích là để mình dùng để tạo file Order NVL cho SX.

Mình xin gửi file ở đây nhờ các cao nhân xử lý giúp nhé.
Mình gửi kèm 2 file. 1 file là file Demo cho data nhỏ, 1 file là hiện trạng của mình. Các cao nhân nào giúp được thì chia sẻ/inbox mình nhé. Cảm ơn cả nhà.
Bài nầy dể hơn . . .
Mã:
Option Explicit

Sub abc()
  Dim arr(), res(), a, d As Object, d2 As Object
  Dim sR&, i&, k&, ik&, j&, key$

  Set d = CreateObject("scripting.dictionary")
  Set d2 = CreateObject("scripting.dictionary")
  With Sheets("DATA")
    arr = .Range("A2", .Range("G" & Rows.Count).End(xlUp)).Value
  End With
  sR = UBound(arr)
  ReDim res(1 To sR * 2, 1 To 6)
  For i = 1 To sR
    d(arr(i, 1)) = d(arr(i, 1)) & "," & i
  Next i
 
  For i = 1 To sR
    If d.exists(arr(i, 4)) Then
      Call DeQui(arr, res, d, d2, k, Split(d(arr(i, 4)), ","), arr(i, 7), arr(i, 1))
    Else
      key = arr(i, 1) & "|" & arr(i, 4)
      If d2.exists(key) = False Then
        k = k + 1
        d2(key) = k
      End If
      ik = d2(key)
      res(ik, 1) = arr(i, 1): res(ik, 3) = arr(i, 4)
      res(ik, 5) = arr(i, 6): res(ik, 6) = res(ik, 6) + arr(i, 7)
    End If
  Next i
  Sheets("BOM").Range("A2").Resize(k, 6) = res
End Sub

Sub DeQui(arr, res, d, d2, k, ByVal a, ByVal sl#, ByVal sp$)
    Dim key$, j&, i&, ik&
    For j = 1 To UBound(a)
      i = CLng(a(j))
      If d.exists(arr(i, 4)) Then
        Call DeQui(arr, res, d, d2, k, Split(d(arr(i, 4)), ","), arr(i, 7) * sl, sp)
      Else
        key = sp & "|" & arr(i, 4)
        If d2.exists(key) = False Then
          k = k + 1
          d2(key) = k
        End If
        ik = d2(key)
        res(ik, 1) = sp: res(ik, 3) = arr(i, 4)
        res(ik, 5) = arr(i, 6): res(ik, 6) = res(ik, 6) + arr(i, 7) * sl
      End If
    Next j
End Sub
 
Bài nầy dể hơn . . .
Mã:
Option Explicit

Sub abc()
  Dim arr(), res(), a, d As Object, d2 As Object
  Dim sR&, i&, k&, ik&, j&, key$

  Set d = CreateObject("scripting.dictionary")
  Set d2 = CreateObject("scripting.dictionary")
  With Sheets("DATA")
    arr = .Range("A2", .Range("G" & Rows.Count).End(xlUp)).Value
  End With
  sR = UBound(arr)
  ReDim res(1 To sR * 2, 1 To 6)
  For i = 1 To sR
    d(arr(i, 1)) = d(arr(i, 1)) & "," & i
  Next i
 
  For i = 1 To sR
    If d.exists(arr(i, 4)) Then
      Call DeQui(arr, res, d, d2, k, Split(d(arr(i, 4)), ","), arr(i, 7), arr(i, 1))
    Else
      key = arr(i, 1) & "|" & arr(i, 4)
      If d2.exists(key) = False Then
        k = k + 1
        d2(key) = k
      End If
      ik = d2(key)
      res(ik, 1) = arr(i, 1): res(ik, 3) = arr(i, 4)
      res(ik, 5) = arr(i, 6): res(ik, 6) = res(ik, 6) + arr(i, 7)
    End If
  Next i
  Sheets("BOM").Range("A2").Resize(k, 6) = res
End Sub

Sub DeQui(arr, res, d, d2, k, ByVal a, ByVal sl#, ByVal sp$)
    Dim key$, j&, i&, ik&
    For j = 1 To UBound(a)
      i = CLng(a(j))
      If d.exists(arr(i, 4)) Then
        Call DeQui(arr, res, d, d2, k, Split(d(arr(i, 4)), ","), arr(i, 7) * sl, sp)
      Else
        key = sp & "|" & arr(i, 4)
        If d2.exists(key) = False Then
          k = k + 1
          d2(key) = k
        End If
        ik = d2(key)
        res(ik, 1) = sp: res(ik, 3) = arr(i, 4)
        res(ik, 5) = arr(i, 6): res(ik, 6) = res(ik, 6) + arr(i, 7) * sl
      End If
    Next j
End Sub
Cảm ơn Bro, mình đã thử đoạn code của bạn với file BOM demo thì chạy OK, tuy nhiên, khi thử với file 2024.11.25 thì lại đang báo lỗi đoạn Code này: Call DeQui(arr, res, d, d2, k, Split(d(arr(i, 4)), ","), arr(i, 7) * sl, sp)
Bro có thể hỗ trợ thêm giúp mình không
 
Code này tính luôn ra Material request.
LIệt kê mặt hàng cần sản xuất và số lượng (Manufacturing order), nhấn nút chạy ra chi tiết tất cả thành phần, sau đó dùng Pivot table tổng hợp lại thành material request.
Code này cải tiến từ ý tưởng nối item của Dic từ đại ca @HieuCD
Mã:
Public Material(), SQty(), SProduct(), Result(), IsBOM()
Public m As Long, ManufactQty As Long, LastRw As Long
Public Dict1, NewPrqty As Double, InitialProduct As String
Sub Run()
Dim MOrder(), LRw As Long, ikey As String
ReDim Result(1 To 50000, 1 To 8)
LRw = Sheet2.[A10000].End(xlUp).Row
MOrder = Sheet2.Range("A4:C" & LRw).Value
Sheet2.Range("F4:L300000").ClearContents
Application.ScreenUpdating = False
With Sheets("BOM")
    .AutoFilterMode = 0
    LastRw = .Cells(100000, 1).End(xlUp).Row
    SProduct = .Range("A2:A" & LastRw).Value
    Material = .Range("D2:F" & LastRw).Value
    SQty = .Range("G2:G" & LastRw).Value
End With
t = Timer
Set Dict1 = CreateObject("scripting.dictionary")
    For i = 1 To UBound(SProduct, 1)
            ikey = SProduct(i, 1)
            Dict1.Item(ikey) = Dict1.Item(ikey) & "|" & i
    Next

For i = 1 To UBound(MOrder, 1)
    InitialProduct = MOrder(i, 1)
    ManufactQty = MOrder(i, 3)
    CalculateBOM InitialProduct, ManufactQty
Next
If m > 0 Then
    ActiveSheet.[F4].Resize(m, 8) = Result
End If
Erase Material, SQty, SProduct, Result
Set Dict1 = Nothing
InitialProduct = "": ManufactQty = 0: m = 0
Application.ScreenUpdating = True
MsgBox Timer - t & " seconds", , "Ptm0412"
End Sub
'______________________________'
Sub CalculateBOM(ByVal Product As String, ByVal PrQty As Double)
    Dim S As Variant
   
    S = Split(Dict1.Item(Product), "|")
    For i = 1 To UBound(S)
        j = Val(S(i))
            If Not Dict1.exists(CStr(Material(j, 1))) Then
                m = m + 1
                Result(m, 1) = InitialProduct
                Result(m, 2) = ManufactQty
                Result(m, 3) = Material(j, 1)
                Result(m, 4) = Material(j, 2)
                Result(m, 5) = Material(j, 3)
                Result(m, 7) = SQty(j, 1) * PrQty
                Result(m, 6) = Result(m, 7) / ManufactQty
                Result(m, 8) = Product
            Else
                NewPrqty = SQty(j, 1)
                CalculateBOM Material(j, 1), NewPrqty * PrQty
            End If
    Next i
End Sub

File tính mẫu 13 mặt hàng trong đó 3 dòng đầu có BTP

1732552790329.png

Kết quả 476 chi tiết, Tổng hợp 129 loại nguyên liệu cần dùng


1732552874482.png
 

File đính kèm

Lần chỉnh sửa cuối:
Code này tính luôn ra Material request.
LIệt kê mặt hàng cần sản xuất và số lượng (Manufacturing order), nhấn nút chạy ra chi tiết tất cả thành phần, sau đó dùng Pivot table tổng hợp lại thành material request.
Code này cải tiến từ ý tưởng nối item của Dic từ đại ca @HieuCD
Mã:
Public Material(), SQty(), SProduct(), Result(), IsBOM()
Public m As Long, ManufactQty As Long, LastRw As Long
Public Dict1, NewPrqty As Double, InitialProduct As String
Sub Run()
Dim MOrder(), LRw As Long, ikey As String
ReDim Result(1 To 50000, 1 To 8)
LRw = Sheet2.[A10000].End(xlUp).Row
MOrder = Sheet2.Range("A4:C" & LRw).Value
Sheet2.Range("F4:L300000").ClearContents
Application.ScreenUpdating = False
With Sheets("BOM")
    .AutoFilterMode = 0
    LastRw = .Cells(100000, 1).End(xlUp).Row
    SProduct = .Range("A2:A" & LastRw).Value
    Material = .Range("D2:F" & LastRw).Value
    SQty = .Range("G2:G" & LastRw).Value
End With
t = Timer
Set Dict1 = CreateObject("scripting.dictionary")
    For i = 1 To UBound(SProduct, 1)
            ikey = SProduct(i, 1)
            Dict1.Item(ikey) = Dict1.Item(ikey) & "|" & i
    Next

For i = 1 To UBound(MOrder, 1)
    InitialProduct = MOrder(i, 1)
    ManufactQty = MOrder(i, 3)
    CalculateBOM InitialProduct, ManufactQty
Next
If m > 0 Then
    ActiveSheet.[F4].Resize(m, 8) = Result
End If
Erase Material, SQty, SProduct, Result
Set Dict1 = Nothing
InitialProduct = "": ManufactQty = 0: m = 0
Application.ScreenUpdating = True
MsgBox Timer - t & " seconds", , "Ptm0412"
End Sub
'______________________________'
Sub CalculateBOM(ByVal Product As String, ByVal PrQty As Double)
    Dim S As Variant
  
    S = Split(Dict1.Item(Product), "|")
    For i = 1 To UBound(S)
        j = Val(S(i))
            If Not Dict1.exists(CStr(Material(j, 1))) Then
                m = m + 1
                Result(m, 1) = InitialProduct
                Result(m, 2) = ManufactQty
                Result(m, 3) = Material(j, 1)
                Result(m, 4) = Material(j, 2)
                Result(m, 5) = Material(j, 3)
                Result(m, 7) = SQty(j, 1) * PrQty
                Result(m, 6) = Result(m, 7) / ManufactQty
                Result(m, 8) = Product
            Else
                NewPrqty = SQty(j, 1)
                CalculateBOM Material(j, 1), NewPrqty * PrQty
            End If
    Next i
End Sub

File tính mẫu 13 mặt hàng trong đó 3 dòng đầu có BTP

View attachment 305867

Kết quả 476 chi tiết, Tổng hợp 129 loại nguyên liệu cần dùng


View attachment 305868
Cảm ơn Bro đã hỗ trợ tận khuya. Tí nữa đến cty mình sẽ test code. Mình sẽ phản hồi lại kết quả cho các bro. Hy vọng nó sẽ chạy smooth
 
Kiểm tra lại . . .
Mã:
Option Explicit

Sub xyz()
  Dim arr(), bom2(), bom3(), aTD(), a
  Dim dSP As Object, d As Object, d2 As Object, b2 As Object, b3 As Object
  Dim sR&, sC&, i&, r2&, r3&, k&, c&, j&, vt$

  Set d = CreateObject("scripting.dictionary")
  Set d2 = CreateObject("scripting.dictionary")
  Set dSP = CreateObject("scripting.dictionary")
  Set b2 = CreateObject("scripting.dictionary")
  Set b3 = CreateObject("scripting.dictionary")
 
  aTD = Sheets("BOM2").Range("A2:C3").Value 'Mang dong tieu de
  sC = UBound(aTD, 2) 'So cot tieu de thong tin vat tu
  With Sheets("BOM1")
    arr = .Range("A2", .Range("G" & Rows.Count).End(xlUp)).Value
  End With
  sR = UBound(arr)
 
  For i = 1 To sR
    d(arr(i, 1)) = d(arr(i, 1)) & "," & i
    d2(arr(i, 4)) = ""
  Next i
  For i = 1 To sR 'Loc San Pham
    If d2.exists(arr(i, 1)) = False Then
      If dSP.exists(arr(i, 1)) = False Then
        sC = sC + 1
        dSP(arr(i, 1)) = sC
        ReDim Preserve aTD(1 To 2, 1 To sC)
        aTD(1, sC) = arr(i, 2)
        aTD(2, sC) = arr(i, 1)
      End If
    End If
  Next
  ReDim bom2(1 To sR, 1 To sC)
  ReDim bom3(1 To sR, 1 To sC)
 
  For c = 4 To sC
    a = Split(d(aTD(2, c)), ",")
    For j = 1 To UBound(a)
      i = CLng(a(j))
      vt = arr(i, 4)
      If b2.exists(vt) = False Then
        r2 = r2 + 1
        b2(vt) = r2
      End If
      k = b2(vt)
      bom2(k, 1) = arr(i, 4):      bom2(k, 2) = arr(i, 5)
      bom2(k, 3) = arr(i, 6):      bom2(k, c) = bom2(k, c) + arr(i, 7)

      If b3.exists(vt) = False Then
        r3 = r3 + 1
        b3(vt) = r3
      End If
      k = b3(vt)
      bom3(k, 1) = arr(i, 4):      bom3(k, 2) = arr(i, 5)
      bom3(k, 3) = arr(i, 6):      bom3(k, c) = bom3(k, c) + arr(i, 7)
      If d.exists(vt) Then
        Call DeQui(arr, bom2, bom3, d, b2, b3, r2, r3, c, Split(d(vt), ","), arr(i, 7))
      End If
    Next j
  Next c
  Sheets("BOM2").Range("A2").Resize(2, sC) = aTD
  Sheets("BOM2").Range("A4").Resize(r2, sC) = bom2
  Sheets("BOM3").Range("A2").Resize(2, sC) = aTD
  Sheets("BOM3").Range("A4").Resize(r3, sC) = bom3
End Sub

Sub DeQui(arr, bom2, bom3, d, b2, b3, r2, r3, c, ByVal a, ByVal sl#)
  Dim vt$, j&, i&, k&
    For j = 1 To UBound(a)
      i = CLng(a(j))
      vt = arr(i, 4)
      If b2.exists(vt) = False Then
        r2 = r2 + 1
        b2(vt) = r2
      End If
      k = b2(vt)
      bom2(k, 1) = arr(i, 4):      bom2(k, 2) = arr(i, 5)
      bom2(k, 3) = arr(i, 6):      bom2(k, c) = bom2(k, c) + arr(i, 7) * sl

      If d.exists(vt) Then
        Call DeQui(arr, bom2, bom3, d, b2, b3, r2, r3, c, Split(d(vt), ","), arr(i, 7) * sl)
      Else
        If b3.exists(vt) = False Then
          r3 = r3 + 1
          b3(vt) = r3
        End If
        k = b3(vt)
        bom3(k, 1) = arr(i, 4):      bom3(k, 2) = arr(i, 5)
        bom3(k, 3) = arr(i, 6):      bom3(k, c) = bom3(k, c) + arr(i, 7) * sl
      End If
    Next j
End Sub
Em cảm ơn bác ạ. Code ra đúng kết quả em mong muốn rồi ạ.
Tuy nhiên khi em thay dữ liệu thật vào thì báo lỗi Out of stack space ạ.
Có thể là do dữ liệu của em bị quá lớn, số lượng TP khoảng hơn 300 mã ạ.
 
Code này tính luôn ra Material request.
LIệt kê mặt hàng cần sản xuất và số lượng (Manufacturing order), nhấn nút chạy ra chi tiết tất cả thành phần, sau đó dùng Pivot table tổng hợp lại thành material request.
Code này cải tiến từ ý tưởng nối item của Dic từ đại ca @HieuCD
Mã:
Public Material(), SQty(), SProduct(), Result(), IsBOM()
Public m As Long, ManufactQty As Long, LastRw As Long
Public Dict1, NewPrqty As Double, InitialProduct As String
Sub Run()
Dim MOrder(), LRw As Long, ikey As String
ReDim Result(1 To 50000, 1 To 8)
LRw = Sheet2.[A10000].End(xlUp).Row
MOrder = Sheet2.Range("A4:C" & LRw).Value
Sheet2.Range("F4:L300000").ClearContents
Application.ScreenUpdating = False
With Sheets("BOM")
    .AutoFilterMode = 0
    LastRw = .Cells(100000, 1).End(xlUp).Row
    SProduct = .Range("A2:A" & LastRw).Value
    Material = .Range("D2:F" & LastRw).Value
    SQty = .Range("G2:G" & LastRw).Value
End With
t = Timer
Set Dict1 = CreateObject("scripting.dictionary")
    For i = 1 To UBound(SProduct, 1)
            ikey = SProduct(i, 1)
            Dict1.Item(ikey) = Dict1.Item(ikey) & "|" & i
    Next

For i = 1 To UBound(MOrder, 1)
    InitialProduct = MOrder(i, 1)
    ManufactQty = MOrder(i, 3)
    CalculateBOM InitialProduct, ManufactQty
Next
If m > 0 Then
    ActiveSheet.[F4].Resize(m, 8) = Result
End If
Erase Material, SQty, SProduct, Result
Set Dict1 = Nothing
InitialProduct = "": ManufactQty = 0: m = 0
Application.ScreenUpdating = True
MsgBox Timer - t & " seconds", , "Ptm0412"
End Sub
'______________________________'
Sub CalculateBOM(ByVal Product As String, ByVal PrQty As Double)
    Dim S As Variant
  
    S = Split(Dict1.Item(Product), "|")
    For i = 1 To UBound(S)
        j = Val(S(i))
            If Not Dict1.exists(CStr(Material(j, 1))) Then
                m = m + 1
                Result(m, 1) = InitialProduct
                Result(m, 2) = ManufactQty
                Result(m, 3) = Material(j, 1)
                Result(m, 4) = Material(j, 2)
                Result(m, 5) = Material(j, 3)
                Result(m, 7) = SQty(j, 1) * PrQty
                Result(m, 6) = Result(m, 7) / ManufactQty
                Result(m, 8) = Product
            Else
                NewPrqty = SQty(j, 1)
                CalculateBOM Material(j, 1), NewPrqty * PrQty
            End If
    Next i
End Sub

File tính mẫu 13 mặt hàng trong đó 3 dòng đầu có BTP

View attachment 305867

Kết quả 476 chi tiết, Tổng hợp 129 loại nguyên liệu cần dùng


View attachment 305868
Code này tính luôn ra Material request.
LIệt kê mặt hàng cần sản xuất và số lượng (Manufacturing order), nhấn nút chạy ra chi tiết tất cả thành phần, sau đó dùng Pivot table tổng hợp lại thành material request.
Code này cải tiến từ ý tưởng nối item của Dic từ đại ca @HieuCD
Mã:
Public Material(), SQty(), SProduct(), Result(), IsBOM()
Public m As Long, ManufactQty As Long, LastRw As Long
Public Dict1, NewPrqty As Double, InitialProduct As String
Sub Run()
Dim MOrder(), LRw As Long, ikey As String
ReDim Result(1 To 50000, 1 To 8)
LRw = Sheet2.[A10000].End(xlUp).Row
MOrder = Sheet2.Range("A4:C" & LRw).Value
Sheet2.Range("F4:L300000").ClearContents
Application.ScreenUpdating = False
With Sheets("BOM")
    .AutoFilterMode = 0
    LastRw = .Cells(100000, 1).End(xlUp).Row
    SProduct = .Range("A2:A" & LastRw).Value
    Material = .Range("D2:F" & LastRw).Value
    SQty = .Range("G2:G" & LastRw).Value
End With
t = Timer
Set Dict1 = CreateObject("scripting.dictionary")
    For i = 1 To UBound(SProduct, 1)
            ikey = SProduct(i, 1)
            Dict1.Item(ikey) = Dict1.Item(ikey) & "|" & i
    Next

For i = 1 To UBound(MOrder, 1)
    InitialProduct = MOrder(i, 1)
    ManufactQty = MOrder(i, 3)
    CalculateBOM InitialProduct, ManufactQty
Next
If m > 0 Then
    ActiveSheet.[F4].Resize(m, 8) = Result
End If
Erase Material, SQty, SProduct, Result
Set Dict1 = Nothing
InitialProduct = "": ManufactQty = 0: m = 0
Application.ScreenUpdating = True
MsgBox Timer - t & " seconds", , "Ptm0412"
End Sub
'______________________________'
Sub CalculateBOM(ByVal Product As String, ByVal PrQty As Double)
    Dim S As Variant
  
    S = Split(Dict1.Item(Product), "|")
    For i = 1 To UBound(S)
        j = Val(S(i))
            If Not Dict1.exists(CStr(Material(j, 1))) Then
                m = m + 1
                Result(m, 1) = InitialProduct
                Result(m, 2) = ManufactQty
                Result(m, 3) = Material(j, 1)
                Result(m, 4) = Material(j, 2)
                Result(m, 5) = Material(j, 3)
                Result(m, 7) = SQty(j, 1) * PrQty
                Result(m, 6) = Result(m, 7) / ManufactQty
                Result(m, 8) = Product
            Else
                NewPrqty = SQty(j, 1)
                CalculateBOM Material(j, 1), NewPrqty * PrQty
            End If
    Next i
End Sub

File tính mẫu 13 mặt hàng trong đó 3 dòng đầu có BTP

View attachment 305867

Kết quả 476 chi tiết, Tổng hợp 129 loại nguyên liệu cần dùng


View attachment 305868
Thanks Bro, Mình chạy code này trong Excel thì Office chặn luôn rồi. Nhờ Bro thông não giúp case này với1732589999531.png
 
Thanks Bro, Mình chạy code này trong Excel thì Office chặn luôn rồi. Nhờ Bro thông não giúp case này với
Muốn được giúp đỡ thì bạn không nên viết Tiếng Việt lẫn lộn tiếng Tây thế này, người đọc rất khó chịu, Tây thì Tây hẳn luôn đi.
 
Cũng liên quan đến vấn đề tương tự như thế này, nhờ các cao nhân chỉ giúp file này với ạ.
Sheet DATA của bên em cũng có khoảng hơn 30k dòng. Cột A là mã thành phẩm hoặc bán thành phẩm. Cột D là mã vật tư hoặc mã bán thành phẩm.
Cột G là số lượng Bán thành phẩm hoặc linh kiện ở cột D dùng để cấu thành lên thành phẩm hoặc bán thành phẩm ở Cột A.
Có mốt số mã có cả ở cột A và cột D vì nó là bán thành phẩm: ở cột G thì đóng vai trò là NVL của thành phẩm cột A. Ở cột A thì đóng vai trò là thành phẩm mẹ của các loại NVL riêng ở cột D.
File 2024.11.25 BOM Copy là data gốc.

Giờ em muốn tạo Code VBA để tạo ra 1 BOM của tất cả các loại thành phẩm và bán thành phẩm, trong đó BOM thành phẩm chỉ thể hiện những loại NVL cuối cùng ở Level thấp nhất. nghĩa là sẽ tự Breakdown BOM BTP ra thành các NVL nhỏ hơn, sau đó tổng hợp lại từng loại NVL nhỏ trong BOM thành phẩm.


Mục đích là để mình dùng để tạo file Order NVL cho SX.

Mình xin gửi file ở đây nhờ các cao nhân xử lý giúp nhé.
Mình gửi kèm 2 file. 1 file là file Demo cho data nhỏ, 1 file là hiện trạng của mình. Các cao nhân nào giúp được thì chia sẻ/inbox mình nhé. Cảm ơn cả nhà.
Bài này hôm qua em cũng thử mò, mà thấy BOM BTP (bán thành phẩm) có tận 4 lớp (sâu dữ)=>Không biết em hiểu có chính xác không nữa, vì dữ liệu hơi nhiều, nên vẫn đang loay hoay, không biết có cách phân tích hay xử lý bằng hàm excel365 hoặc power query không, mà lúc sau đau đầu quá, nên từ bỏ :D
1732572947287.png
 
Muốn được giúp đỡ thì bạn không nên viết Tiếng Việt lẫn lộn tiếng Tây thế này, người đọc rất khó chịu, Tây thì Tây hẳn luôn đi.
Cảm ơn góp ý của bạn. Mình sẽ lưu ý
Bài đã được tự động gộp:

Vâng, đúng là BOM của nó có nhiều lớp. Nhưng mình chỉ cần tính đến NVL đầu vào thôi, các lớp trung gian bỏ qua cho đỡ rối mắt
 
Cảm ơn góp ý của bạn. Mình sẽ lưu ý
Bài đã được tự động gộp:

Vâng, đúng là BOM của nó có nhiều lớp. Nhưng mình chỉ cần tính đến NVL đầu vào thôi, các lớp trung gian bỏ qua cho đỡ rối mắt
Tư duy của em chưa được tốt nhưng theo ý hiểu của em thì phải bóc tách ra thì mới tính được tới NVL đầu vào chứ nhỉ??? Rất mong các anh/chị và mọi người có kiến thức về BOM_nói chung, hướng dẫn thêm về logic BOM với ạ, vì em cũng muốn tìm hiểu về vấn đề này
1732579937298.png
 
Lần chỉnh sửa cuối:
Tư duy của em chưa được tốt nhưng theo ý hiểu của em thì phải bóc tách ra thì mới tính được tới NVL đầu vào chứ nhỉ??? Rất mong các anh/chị hướng dẫn thêm về logic BOM với ạ, vì em cũng muốn tìm hiểu về vấn đề này
View attachment 305884
Bạn xem lại bài 4 của mình nhé nhé. Bình thường thì hệ thống nào cũng sẽ có trường quy định loại của linh kiện, vật tư là Thành phẩm, Bán thành phẩm hay NVL...Nhưng nếu không đưa dữ liệu đầy đủ lên thì có thể dựa theo logic như sau:
Trong bảng BOM sẽ bao gồm mã cha (TP - BTP) và mã con (BTP - NVL). Nếu mã nào nó vừa có trong cột mã cha, vừa có trong cột mã con thì nó là BTP, nếu mã nào chỉ có trong cột mã cha thì nó là TP, chỉ có trong cột mã con thì nó là NVL. Mình nghĩ lập luận như trên thì mới đúng. Nhưng nếu nói về cấu hình trên hệ thống thì nhiều khi nó cũng không đúng lắm vì ví dụ 1 linh kiện cơ khí nếu đi mua thì nó là NVL, nhưng nếu tự sản xuất thì nó lại là BTP (làm từ bao nhiêu kg sắt thép chẳng hạn). Hoặc một số Thành phẩm dù không làm gì nữa, Không có mã cha nhưng bên kế toán nhà mình cứ bắt phải để là BTP để còn tính giá cho chuẩn (chỗ này mình nghe họ nói vậy chứ cũng không hiểu)
 
Cảm ơn Bro, mình đã thử đoạn code của bạn với file BOM demo thì chạy OK, tuy nhiên, khi thử với file 2024.11.25 thì lại đang báo lỗi đoạn Code này: Call DeQui(arr, res, d, d2, k, Split(d(arr(i, 4)), ","), arr(i, 7) * sl, sp)
Bro có thể hỗ trợ thêm giúp mình không
Do dòng dữ liệu 3529 sai, xóa hoặc chỉnh lại code sẽ chạy ngon
Em cảm ơn bác ạ. Code ra đúng kết quả em mong muốn rồi ạ.
Tuy nhiên khi em thay dữ liệu thật vào thì báo lỗi Out of stack space ạ.
Có thể là do dữ liệu của em bị quá lớn, số lượng TP khoảng hơn 300 mã ạ.
Có thể dữ liệu sai giống như file của bạn trên
 
Cảm ơn chuyên gia, mình xoá dòng code đó đi thì vận hành OK rồi. Tuy nhiên, nếu sửa dòng code đó thì sẽ có thêm lợi ích là gì nhỉ
Bài đã được tự động gộp:

Tư duy của em chưa được tốt nhưng theo ý hiểu của em thì phải bóc tách ra thì mới tính được tới NVL đầu vào chứ nhỉ??? Rất mong các anh/chị và mọi người có kiến thức về BOM_nói chung, hướng dẫn thêm về logic BOM với ạ, vì em cũng muốn tìm hiểu về vấn đề này
View attachment 305884
Có lẽ bạn chưa hiểu ý diễn giải của mình:
Trong cột A có các mã Mẹ, Bà, Cụ, Kỵ, Tổ Tiên.. Trong cột D có mã Con, Cháu, Chắt, Chút, Chít. Các mã trong cột A sẽ có con trực hệ ở cột D. Các mã trong cột D có thể là linh kiện hoặc là Bán thành phẩm. Nêud là linh kiện thì nó chỉ xuất hiện ở cột D thôi. Nếu là BTP thì chắc chắn nó sẽ được xuất hiện ở côt A với tư cách là mã mẹ, và song song với nó ở cột D sẽ có các mã con trực tiếp. Cứ như thế dần dần sẽ phân chia đến các lớp BTP nhỏ nhất
 
Lần chỉnh sửa cuối:
Thanks Bro, Mình chạy code này trong Excel thì Office chặn luôn rồi. Nhờ Bro thông não giúp case này với
Tôi không phải bro, vì chẳng có rồ chút nào. File bị chặn vì untrusted, vậy thì tìm chỗ thiết lập để trust nó.
Bài này hôm qua em cũng thử mò, mà thấy BOM BTP (bán thành phẩm) có tận 4 lớp (sâu dữ)=>Không biết em hiểu có chính xác không nữa, vì dữ liệu hơi nhiều, nên vẫn đang loay hoay, không biết có cách phân tích hay xử lý bằng hàm excel365 hoặc power query không, mà lúc sau đau đầu quá, nên từ bỏ :D
Hàm và công thức thì khó dù là hàm 365. Vì phải đệ quy. Power query cũng có đệ quy nhưng cũng khó trầy trật.
Giải thích BOM nhiều lớp như sau:

SPA là level 1
SPA có các thành phần A1, A2, A3, A4 trong đó giả sử A2 là bán thành phẩm.
Để sản xuất 1 SPA cần
A1 = 1
A2 = 2
A3 = 2
A4 = 2

Để sản xuất 1 đơn vị BTP A2 (level 2) cần
A4 = 1
A5 = 5
A6 = 3

Giả sử A5 lại là bán thành phẩm (level 3)
Để SX 1 đơn vị A5 cần
A7 = 4
A8 = 5

Minh họa như sau, và xem file đính kèm. Lệnh sản xuất ghi 100 SP A thì nhân lên 100

1732637524129.png
 

File đính kèm

Áp dụng cho bài 1. Ra thẳng thống kê vật tư. Còn 2 sheet BOM2 và BOM3 liệt kê theo cột thì tôi không thích lắm nên không làm. Làm cho 3 loại tủ xong khi áp cho dữ liệu thực 20 loại là vất code hết.
Ghi chú:
Dòng 26 file gốc sheet BOM sai (SPW4400100901), đúng ra là SPW4400101000
 

File đính kèm

Áp dụng cho bài 1. Ra thẳng thống kê vật tư. Còn 2 sheet BOM2 và BOM3 liệt kê theo cột thì tôi không thích lắm nên không làm. Làm cho 3 loại tủ xong khi áp cho dữ liệu thực 20 loại là vất code hết.
Ghi chú:
Dòng 26 file gốc sheet BOM sai (SPW4400100901), đúng ra là SPW4400101000
Em xem qua thấy chịu không nổi.
 
Áp dụng cho bài 1. Ra thẳng thống kê vật tư. Còn 2 sheet BOM2 và BOM3 liệt kê theo cột thì tôi không thích lắm nên không làm. Làm cho 3 loại tủ xong khi áp cho dữ liệu thực 20 loại là vất code hết.
Ghi chú:
Dòng 26 file gốc sheet BOM sai (SPW4400100901), đúng ra là SPW4400101000
Em cảm ơn bác, em test code của bác từ bài trên vào bài của em được rồi ạ. Em với bạn Trannamhai là cùng công ty, nếu chạy một phần dữ liệu thì code chạy rất nhanh, nhưng khi chạy đầy đủ dữ liệu thì báo lỗi Out of stack space (code của bác HiếuCD cũng báo vậy ạ)
Bài đã được tự động gộp:

BOM2 của mình chỉ cần hiện nên chiều dọc là danh sách NVL còn chiều ngang là danh sách thành phẩm mà thôi.
Mục đích chủ yếu của mình nhờ giúp đỡ cũng chủ yếu là làm như thế nào để có thể bóc tách thành phẩm đến NVL cuối cùng, như bài của các bác @HieuCD @ptm0412 đã giúp, còn cái BOM2, BOM3 khi đã bóc tách được thì dùng pivot table là ra được kết quả thôi.
Cảm ơn bạn và các bác trên diễn đàn đã đọc và hỗ trợ mình.
 
Lần chỉnh sửa cuối:
Em cảm ơn bác, em test code của bác từ bài trên vào bài của em được rồi ạ. Em với bạn Trannamhai là cùng công ty, nếu chạy một phần dữ liệu thì code chạy rất nhanh, nhưng khi chạy đầy đủ dữ liệu thì báo lỗi Out of stack space (code của bác HiếuCD cũng báo vậy ạ)
Một phần dữ liệu là bao nhiêu? Tôi đã chạy hết bảng BOM 32600 dòng. Còn lệnh sản xuất test 13 mặt hàng chỉ 0.08 giây. Chạy lệnh SX 200 mặt hàng mất 0.17 giây, 300 mặt hàng 0.19 giây. Chỉ đến khi chạy 500 mặt hàng mới lỗi tràn bộ nhớ chứ không phải lỗi code.
Kiểm tra lại thì dòng 5329 sản phẩm có nguyên liệu là chính nó.

1732804054345.png

Cái này sinh ra vòng lặp vô tận, đệ quy cả đời không hết. May là nó không treo liệt cả máy.

Sửa dòng này thì chạy hết cả 1700 mặt hàng (lọc duy nhất ra) chỉ 0.95 giây.

1732804325093.png
 
Lần chỉnh sửa cuối:
Một phần dữ liệu là bao nhiêu? Tôi đã chạy hết bảng BOM 32600 dòng. Còn lệnh sản xuất test 13 mặt hàng chỉ 0.08 giây. Chạy lệnh SX 200 mặt hàng mất 0.17 giây, 300 mặt hàng 0.19 giây. Chỉ đến khi chạy 500 mặt hàng mới lỗi tràn bộ nhớ chứ không phải lỗi code.
Kiểm tra lại thì dòng 5259 sản phẩm có nguyên liệu là chính nó.

View attachment 305965

Cái này sinh ra vòng lặp vô tận, đệ quy cả đời không hết. May là nó không treo liệt cả máy.

Sửa dòng này thì chạy hết cả 1700 mặt hàng (lọc duy nhất ra) chỉ 0.95 giây.

View attachment 305966
Vâng ạ. Em đã sửa lại và code chạy OK rồi ạ, cảm ơn bác cùng bác @HieuCD đã giúp đỡ ạ
 
Em cảm ơn bác, em test code của bác từ bài trên vào bài của em được rồi ạ. Em với bạn Trannamhai là cùng công ty, nếu chạy một phần dữ liệu thì code chạy rất nhanh, nhưng khi chạy đầy đủ dữ liệu thì báo lỗi Out of stack space (code của bác HiếuCD cũng báo vậy ạ)
Bài đã được tự động gộp:


BOM2 của mình chỉ cần hiện nên chiều dọc là danh sách NVL còn chiều ngang là danh sách thành phẩm mà thôi.
Mục đích chủ yếu của mình nhờ giúp đỡ cũng chủ yếu là làm như thế nào để có thể bóc tách thành phẩm đến NVL cuối cùng, như bài của các bác @HieuCD @ptm0412 đã giúp, còn cái BOM2, BOM3 khi đã bóc tách được thì dùng pivot table là ra được kết quả thôi.
Cảm ơn bạn và các bác trên diễn đàn đã đọc và hỗ trợ mình.
Như vậy code đã chạy ra đúng yêu cầu của Bạn
 
Em với bạn Trannamhai là cùng công ty,
Thế hai bạn có học cùng trường cùng lớp không?
Cả 2 đều có dữ liệu sai mà không biết. Một người thì BTP không có BOM con vì BOM con sai mã, một người thì nguyên vật liệu SX ra BTP lại là chính nó.
 
Thế hai bạn có học cùng trường cùng lớp không?
Cả 2 đều có dữ liệu sai mà không biết. Một người thì BTP không có BOM con vì BOM con sai mã, một người thì nguyên vật liệu SX ra BTP lại là chính nó.
Cảm ơn chuyên gia đã hỗ trợ và đã tìm ra những điểm lỗi trong file bên mình.
 
Bài nầy dể hơn . . .
Mã:
Option Explicit

Sub abc()
  Dim arr(), res(), a, d As Object, d2 As Object
  Dim sR&, i&, k&, ik&, j&, key$

  Set d = CreateObject("scripting.dictionary")
  Set d2 = CreateObject("scripting.dictionary")
  With Sheets("DATA")
    arr = .Range("A2", .Range("G" & Rows.Count).End(xlUp)).Value
  End With
  sR = UBound(arr)
  ReDim res(1 To sR * 2, 1 To 6)
  For i = 1 To sR
    d(arr(i, 1)) = d(arr(i, 1)) & "," & i
  Next i
 
  For i = 1 To sR
    If d.exists(arr(i, 4)) Then
      Call DeQui(arr, res, d, d2, k, Split(d(arr(i, 4)), ","), arr(i, 7), arr(i, 1))
    Else
      key = arr(i, 1) & "|" & arr(i, 4)
      If d2.exists(key) = False Then
        k = k + 1
        d2(key) = k
      End If
      ik = d2(key)
      res(ik, 1) = arr(i, 1): res(ik, 3) = arr(i, 4)
      res(ik, 5) = arr(i, 6): res(ik, 6) = res(ik, 6) + arr(i, 7)
    End If
  Next i
  Sheets("BOM").Range("A2").Resize(k, 6) = res
End Sub

Sub DeQui(arr, res, d, d2, k, ByVal a, ByVal sl#, ByVal sp$)
    Dim key$, j&, i&, ik&
    For j = 1 To UBound(a)
      i = CLng(a(j))
      If d.exists(arr(i, 4)) Then
        Call DeQui(arr, res, d, d2, k, Split(d(arr(i, 4)), ","), arr(i, 7) * sl, sp)
      Else
        key = sp & "|" & arr(i, 4)
        If d2.exists(key) = False Then
          k = k + 1
          d2(key) = k
        End If
        ik = d2(key)
        res(ik, 1) = sp: res(ik, 3) = arr(i, 4)
        res(ik, 5) = arr(i, 6): res(ik, 6) = res(ik, 6) + arr(i, 7) * sl
      End If
    Next j
End Sub
Bác @HieuCD ơi, bác có thể thêm code để tính ra giúp em ra cột I - Sản phẩm cuối giống như ví dụ của em ở bài 1 được không ạ.
Trong bài của bác @ptm0412 thì có cột này rồi tuy nhiên có 2 điểm em chưa dùng được luôn vì KHSX nhà em luôn luôn thay đổi. Vì vậy để tính toán đươc thì em phải cho vào KHSX là tất cả danh sách Thành phẩm (phải liệt kê ra) và kết quả của bác ý bỏ bớt các bán thành phẩm trung gian ra thẳng đến nguyên vật liệu cuối cùng nên em không có dữ liệu để biết sản phẩm cuối cùng của các bán thành phẩm trung gian là cái gì.
Kính mong hai bác giúp đỡ ạ.
Em cảm ơn!
 
Trong bài của bác @ptm0412 thì có cột này rồi tuy nhiên có 2 điểm em chưa dùng được luôn vì KHSX nhà em luôn luôn thay đổi. Vì vậy để tính toán đươc thì em phải cho vào KHSX là tất cả danh sách Thành phẩm (phải liệt kê ra) và kết quả của bác ý bỏ bớt các bán thành phẩm trung gian ra thẳng đến nguyên vật liệu cuối cùng nên em không có dữ liệu để biết sản phẩm cuối cùng của các bán thành phẩm trung gian là cái gì.
Nói về code của tôi:
Cột cuối cùng (Parent) chính là cột BTP
Ý nghĩa của code là tạo nhu cầu NVL cho 1 đơn hàng sản xuất (MO - Manufacturing order), không phải cho kế hoạch sản xuất.
Code đáp ứng cho bài 16 của trannamhai051284. Bạn này nói ở bài 26:
"Nhưng mình chỉ cần tính đến NVL đầu vào thôi, các lớp trung gian bỏ qua cho đỡ rối mắt"
Còn bạn nói ở bài 35:
còn cái BOM2, BOM3 khi đã bóc tách được thì dùng pivot table là ra được kết quả thôi.
Khi áp dụng cho bài 1 thì tôi có nói: "Áp dụng cho bài 1. Ra thẳng thống kê vật tư. Còn 2 sheet BOM2 và BOM3 liệt kê theo cột thì tôi không thích lắm nên không làm. Làm cho 3 loại tủ xong khi áp cho dữ liệu thực 20 loại là vất code hết."

Kế hoạch sản xuất: sản xuất cái gì và số lượng bao nhiêu, để giao cho xưởng sản xuất
Yêu cầu vật tư: Sử dụng cái gì và số lượng bao nhiêu, giao cho kho và phòng vật tư (hoặc phòng thu mua)

Vậy thì:
Bạn có 1 yêu cầu mới cho KHSX (kế hoạch SX) chứ không phải yêu cầu vật tư. Vậy đừng nói rằng code cũ không đáp ứng được.
 
Lần chỉnh sửa cuối:
Nói về code của tôi:
Cột cuối cùng (Parent) chính là cột BTP
Ý nghĩa của code là tạo nhu cầu NVL cho 1 đơn hàng sản xuất (MO - Manufacturing order), không phải cho kế hoạch sản xuất.
Code đáp ứng cho bài 16 của trannamhai051284. Bạn này nói ở bài 26:
"Nhưng mình chỉ cần tính đến NVL đầu vào thôi, các lớp trung gian bỏ qua cho đỡ rối mắt"
Còn bạn nói ở bài 35:
còn cái BOM2, BOM3 khi đã bóc tách được thì dùng pivot table là ra được kết quả thôi.
Khi áp dụng cho bài 1 thì tôi có nói: "Áp dụng cho bài 1. Ra thẳng thống kê vật tư. Còn 2 sheet BOM2 và BOM3 liệt kê theo cột thì tôi không thích lắm nên không làm. Làm cho 3 loại tủ xong khi áp cho dữ liệu thực 20 loại là vất code hết."

Kế hoạch sản xuất: sản xuất cái gì và số lượng bao nhiêu, để giao cho xưởng sản xuất
Yêu cầu vật tư: Sử dụng cái gì và số lượng bao nhiêu, giao cho kho và phòng vật tư (hoặc phòng thu mua)

Vậy thì:
Bạn có 1 yêu cầu mới cho KHSX (kế hoạch SX) chứ không phải yêu cầu vật tư. Vậy đừng nói rằng code cũ không đáp ứng được.
Em cảm ơn bác. Giống như ở bài 35 em có ghi dùng pivot table là ra được kết quả. Tuy nhiên phần bóc tách bác đã bỏ qua các lớp trung gian nên em không có dữ liệu để ra được kết quả mong muốn ạ. Kính mong bác hỗ trợ giúp ạ
 
Bác @HieuCD ơi, bác có thể thêm code để tính ra giúp em ra cột I - Sản phẩm cuối giống như ví dụ của em ở bài 1 được không ạ.
Trong bài của bác @ptm0412 thì có cột này rồi tuy nhiên có 2 điểm em chưa dùng được luôn vì KHSX nhà em luôn luôn thay đổi. Vì vậy để tính toán đươc thì em phải cho vào KHSX là tất cả danh sách Thành phẩm (phải liệt kê ra) và kết quả của bác ý bỏ bớt các bán thành phẩm trung gian ra thẳng đến nguyên vật liệu cuối cùng nên em không có dữ liệu để biết sản phẩm cuối cùng của các bán thành phẩm trung gian là cái gì.
Kính mong hai bác giúp đỡ ạ.
Em cảm ơn!
Cột I có thể làm người dùng hiểu nhầm bán thành phẩm chỉ dùng cho 1 sản phẩm
Kết quả tạm gán ở cột K
Mã:
Sub xyz2()
  Dim arr(), res(), d As Object, dsp As Object
  Dim sR&, i&

  Set d = CreateObject("scripting.dictionary")
  Set dsp = CreateObject("scripting.dictionary")
  With Sheets("BOM1")
    arr = .Range("A2", .Range("D" & Rows.Count).End(xlUp)).Value
  End With
  sR = UBound(arr)
  ReDim res(1 To sR, 1 To 1)
  For i = 1 To sR
    If Not dsp.exists(arr(i, 1)) Then dsp(arr(i, 1)) = arr(i, 2)
    If Not d.exists(arr(i, 4)) Then d(arr(i, 4)) = arr(i, 1)
  Next i

  For i = 1 To sR
    If d.exists(arr(i, 1)) Then
      Call DeQui2(arr, res, d, dsp, d(arr(i, 1)), i)
    Else
      res(i, 1) = arr(i, 2)
    End If
  Next i
  Sheets("BOM1").Range("K2").Resize(sR) = res
End Sub

Sub DeQui2(arr, res, d, dsp, ByVal btp$, ByVal r&)
    If d.exists(btp) Then
      Call DeQui2(arr, res, d, dsp, d(btp), r)
    Else
      res(r, 1) = dsp(btp)
    End If
End Sub
 
Cột I có thể làm người dùng hiểu nhầm bán thành phẩm chỉ dùng cho 1 sản phẩm
Kết quả tạm gán ở cột K
Mã:
Sub xyz2()
  Dim arr(), res(), d As Object, dsp As Object
  Dim sR&, i&

  Set d = CreateObject("scripting.dictionary")
  Set dsp = CreateObject("scripting.dictionary")
  With Sheets("BOM1")
    arr = .Range("A2", .Range("D" & Rows.Count).End(xlUp)).Value
  End With
  sR = UBound(arr)
  ReDim res(1 To sR, 1 To 1)
  For i = 1 To sR
    If Not dsp.exists(arr(i, 1)) Then dsp(arr(i, 1)) = arr(i, 2)
    If Not d.exists(arr(i, 4)) Then d(arr(i, 4)) = arr(i, 1)
  Next i

  For i = 1 To sR
    If d.exists(arr(i, 1)) Then
      Call DeQui2(arr, res, d, dsp, d(arr(i, 1)), i)
    Else
      res(i, 1) = arr(i, 2)
    End If
  Next i
  Sheets("BOM1").Range("K2").Resize(sR) = res
End Sub

Sub DeQui2(arr, res, d, dsp, ByVal btp$, ByVal r&)
    If d.exists(btp) Then
      Call DeQui2(arr, res, d, dsp, d(btp), r)
    Else
      res(r, 1) = dsp(btp)
    End If
End Sub
Em cảm ơn bác, em thấy ra kết quả rồi, tuy nhiên kết quả này bằng đúng cột B nên chưa đúng như em mong muốn ạ.
Bác gộp luôn kết quả này vào sheet mới tính ra giúp em với ạ.1733990113126.png
 
Em cảm ơn bác, em thấy ra kết quả rồi, tuy nhiên kết quả này bằng đúng cột B nên chưa đúng như em mong muốn ạ.
Bác gộp luôn kết quả này vào sheet mới tính ra giúp em với ạ.
Bạn gởi file với kết quả như thế nào mình sẽ viết lại code
 
Bạn gởi file với kết quả như thế nào mình sẽ viết lại code
Em gửi lại bác ạ. Em cảm ơn!
Như file em đính kèm, em cần tính thêm cái cột H ở cái sheet BOM2 (ở ví dụ em ghi tên sản phẩm cho dễ phân biệt, còn trong code bác giúp em là mã linh kiện ạ).
 

File đính kèm

Áp dụng cho bài 1. Ra thẳng thống kê vật tư. Còn 2 sheet BOM2 và BOM3 liệt kê theo cột thì tôi không thích lắm nên không làm. Làm cho 3 loại tủ xong khi áp cho dữ liệu thực 20 loại là vất code hết.
Ghi chú:
Dòng 26 file gốc sheet BOM sai (SPW4400100901), đúng ra là SPW4400101000
Chào bác! Em sử dụng file này thấy báo lỗi nếu không sản xuất đủ 3 sản phẩm. Ví dụ em chỉ cần sản xuất tủ A và B thôi. Bác có thể chỉnh file này để tính ra vật tư cần sử dụng cho các sản phẩm có số lượng không? Xin cám ơn bác.
 
Chào bác! Em sử dụng file này thấy báo lỗi nếu không sản xuất đủ 3 sản phẩm. Ví dụ em chỉ cần sản xuất tủ A và B thôi. Bác có thể chỉnh file này để tính ra vật tư cần sử dụng cho các sản phẩm có số lượng không? Xin cám ơn bác.
Tôi chạy 2 SP không thấy lỗi gì. Số lượng mong muốn là cột C đấy thôi?

1757427016664.png
 

Bài viết mới nhất

Back
Top Bottom