Định mức nguyên vật liệu (7 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:
Web KT

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

Back
Top Bottom