Hỗ trợ điền dữ liệu tự động bằng VBA (4 người xem)

[BuiQuangThuan]

Chào các anh chị và thầy cô.

Nhờ các anh chị nào đi qua topic nào có thể hướng dẫn hoặc hỗ trợ giúp em vài toán này với ạ?

Hiện tại em đang có 3 sheet

1. Sheet DATA: dữ liệu được xuất ra từ phần mềm


2. Sheet CHUNG TU: dữ liệu được làm thủ công



3. Sheet KET QUA: Kết quả mong muốn nhặt dữ liệu từ sheet Data dựa vào sheet chứng từ để có được kết quả
Về logic thì dựa vào dữ liệu từ sheet chứng từ và sheet data.
Ví dụ chứng từ Mã sản phẩm :3472T 9299B B 1JS ở pallet 1 có 8 thùng ( tức là 6000/ thùng) thì sẽ dò sang data để nhặt số lượng và số Lot đưa về kết quả
Trường hợp nếu bên data có nhiều số lượng ghép vào nhau để tròng thùng thì sẽ nhặt hết số lượng và số Lot.
Nếu trùng số lot thì chỉ điền 1 lần và số thùng sẽ là số lần đếm được.
Trong file là phần kết quả em có làm bằng tay thủ công.


Rất mong các Thầy Cô, Anh Chị có ý tưởng nào gợi ý giúp em với ạ
Loay hoay sài dic mà không có ra.
Em xin chân thành cám ơn

 

[hvnhpro]

Trước mình cũng từng làm vụ quản lý nhập vật tư mà đọc bài bạn xong cũng không hiểu luôn

Theo bạn ghi Ví dụ chứng từ Mã sản phẩm :3472T 9299B B 1JS ở pallet 1 có 8 thùng ( tức là 6000/ thùng), ở sheet Data là 48,000 qty 4 Lot No 2 Pallet No. thì nguyên lý gì để chia 3 cột như bạn đang chia?

 

[BuiQuangThuan]

Trước mình cũng từng làm vụ quản lý nhập vật tư mà đọc bài bạn xong cũng không hiểu luôn

Theo bạn ghi Ví dụ chứng từ Mã sản phẩm :3472T 9299B B 1JS ở pallet 1 có 8 thùng ( tức là 6000/ thùng), ở sheet Data là 48,000 qty 4 Lot No 2 Pallet No. thì nguyên lý gì để chia 3 cột như bạn đang chia?

Cám ơn anh đã quan tâm
Cái form nó cố định là 3 cột như trong file. có lẽ là để lúc in ra file cứng nhìn nó đỡ trống trải và đỡ tốn giấy. mặc dù nó có 8 thùng. Nhưng số lượng nó lại không phải là chẵn 6000. mà nó lại là ghép của nhiều số Lot nhỏ lại với nhau thành 6000.
Bảng kết quả thực chất là bảng kê lại chi tiết theo từng số Lot
Hoặc hiểu đơn giản là mã 3472T 9299B B 1JS bên sheet data chi tiết:
Thùng 1:
B241116-1V 5,770.00
B241118-1V 230.00 ====> tổng bằng 6000
Thùng 2:
'B241118-1V 4,070.00
'B241119-1V 1,930.00 ====> Tổng bằng 6000
Thùng 3:
'B241116-1V 5,245.00
'B241118-1V 755.00 ====> Tổng bằng 6000
Thùng 4:
'B241118-1V 125.00
'B241119-1V 5,875.00 ====> Tổng bằng 6000
Thùng 5:
'B241118-1V 230.00
'B241119-1V 5,770.00
Thùng 6:
'B241116-1V 5,760.00
'B241118-1V 240.00
Thùng 7
'B241116-1V 565.00
'B241118-1V 5,435.00
Và thùng 8 là thùng chẵn
'B241118-1V 6,000.00

Thì khi đưa sang kết quả. em có 3 cột để thể hiện thì cứ nhặt dữ liệu sao cho nó dàn đều và tốn ít dòng nhất có thể là được. Không biết cách em mô tả có làm anh khó hiểu không ạ

 

[DeTong]

Sheet CHUNG TU: dữ liệu được làm thủ công

Có vẻ chưa đúng ...

 

[BuiQuangThuan]

Có vẻ chưa đúng ...

Cám ơn anh đã quan tâm. Không phải là không đúng đâu ạ
Kiểu quy trình nó sẽ là như này. bên kinh doanh họ sẽ đưa chứng từ để bên kho xếp hàng. chẳng hạn chứng từ có mã A 3 thùng tổng số lượng là 3000
Khi kho nhận được. Họ sẽ lấy 3 thùng ra để xếp vào pallet. và thực hiện xuất bằng mã vạch. sau khi xuất thì được dữ liệu như sheet data
Trong 3 thùng này nếu là chẵn số lượng (tức là không ghép nối) và cùng 1 số Lot thì ở sheet kết quả sẽ kê lại mã hàng đó và số lot và tổng số thùng.
Còn nếu số lượng trong 1 thùng mà có nhiều số lot khác nhau nối lại với nhau thì cũng phải kê lại chi tiết từng số lot, số lượng của thùng ấy

 

[yaaasoo01]

Cám ơn anh đã quan tâm
Cái form nó cố định là 3 cột như trong file. có lẽ là để lúc in ra file cứng nhìn nó đỡ trống trải và đỡ tốn giấy. mặc dù nó có 8 thùng. Nhưng số lượng nó lại không phải là chẵn 6000. mà nó lại là ghép của nhiều số Lot nhỏ lại với nhau thành 6000.
Bảng kết quả thực chất là bảng kê lại chi tiết theo từng số Lot
Hoặc hiểu đơn giản là mã 3472T 9299B B 1JS bên sheet data chi tiết:
Thùng 1:
B241116-1V 5,770.00
B241118-1V 230.00 ====> tổng bằng 6000
Thùng 2:
'B241118-1V 4,070.00
'B241119-1V 1,930.00 ====> Tổng bằng 6000
Thùng 3:
'B241116-1V 5,245.00
'B241118-1V 755.00 ====> Tổng bằng 6000
Thùng 4:
'B241118-1V 125.00
'B241119-1V 5,875.00 ====> Tổng bằng 6000
Thùng 5:
'B241118-1V 230.00
'B241119-1V 5,770.00
Thùng 6:
'B241116-1V 5,760.00
'B241118-1V 240.00
Thùng 7
'B241116-1V 565.00
'B241118-1V 5,435.00
Và thùng 8 là thùng chẵn
'B241118-1V 6,000.00

Thì khi đưa sang kết quả. em có 3 cột để thể hiện thì cứ nhặt dữ liệu sao cho nó dàn đều và tốn ít dòng nhất có thể là được. Không biết cách em mô tả có làm anh khó hiểu không ạ

Theo như ví dụ của bác thì mình cần tìm các Lot có tổng = 6000 và gom lại thành 1 thùng ạ. Như vậy thì sẽ có rất nhiều TH xảy ra và mình cần tổng quát cho bài toán n Lot. Quá khó bro ạ!!!

 

[HieuCD]

Chào các anh chị và thầy cô.

Nhờ các anh chị nào đi qua topic nào có thể hướng dẫn hoặc hỗ trợ giúp em vài toán này với ạ?

Hiện tại em đang có 3 sheet

1. Sheet DATA: dữ liệu được xuất ra từ phần mềm
View attachment 306327

2. Sheet CHUNG TU: dữ liệu được làm thủ công

View attachment 306328

3. Sheet KET QUA: Kết quả mong muốn nhặt dữ liệu từ sheet Data dựa vào sheet chứng từ để có được kết quả
Về logic thì dựa vào dữ liệu từ sheet chứng từ và sheet data.
Ví dụ chứng từ Mã sản phẩm :3472T 9299B B 1JS ở pallet 1 có 8 thùng ( tức là 6000/ thùng) thì sẽ dò sang data để nhặt số lượng và số Lot đưa về kết quả
Trường hợp nếu bên data có nhiều số lượng ghép vào nhau để tròng thùng thì sẽ nhặt hết số lượng và số Lot.
Nếu trùng số lot thì chỉ điền 1 lần và số thùng sẽ là số lần đếm được.
Trong file là phần kết quả em có làm bằng tay thủ công.
View attachment 306329

Rất mong các Thầy Cô, Anh Chị có ý tưởng nào gợi ý giúp em với ạ
Loay hoay sài dic mà không có ra.
Em xin chân thành cám ơn

Kiểm tra lại . . .

Option Explicit

Sub xyz()
  Dim arr(), ct(), a, b&(), res(), Ws As Worksheet, dic As Object, key$, key2$
  Dim srCT&, srArr&, i&, r&, k&, j&, c&
  Dim pallet&, T&, tmp&, inv$, sp&, cMax&
 
  ReDim res(1 To 100, 1 To 14)
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("Chung tu")
    ct = .Range("A4", .Range("E" & Rows.Count).End(3)).Value
  End With
  With Sheets("Data")
    arr = .Range("F3", .Range("X" & Rows.Count).End(3).Offset(1)).Value
  End With
  srCT = UBound(ct): srArr = UBound(arr) - 1
  arr(UBound(arr), 2) = "00000"
  arr(1, 2) = arr(1, 1) & "|" & CLng(Right(arr(1, 2), 4)) & "|" & arr(1, 3) 'key of dictionary
 
  For i = 1 To srArr
    arr(i + 1, 2) = arr(i + 1, 1) & "|" & CLng(Right(arr(i + 1, 2), 4)) & "|" & arr(i + 1, 3)
    If dic.exists(arr(i, 2)) = False Then dic.Add arr(i, 2), i
    If arr(i, 2) <> arr(i + 1, 2) Then
      dic(arr(i, 2)) = Array(dic(arr(i, 2)), i)
    End If
  Next i
  Set Ws = Sheets("Ket Qua")
  inv = Mid(Ws.Range("D2"), InStrRev(Ws.Range("D2"), " ") + 1)
 
  For i = 1 To srCT
    If pallet <> ct(i, 1) Then
      pallet = ct(i, 1)
      res(k + 1, 1) = pallet
    End If
    If sp <> ct(i, 2) Or pallet <> ct(i, 1) Then
      res(k + 1, 2) = ct(i, 2)
      res(k + 1, 3) = ct(i, 3)
      res(k + 1, 5) = ct(i, 5)
    End If
    
    T = ct(i, 3) / ct(i, 5) 'So SP/lot
    key = inv & "|" & pallet & "|" & ct(i, 2)
    a = dic(key)
    res(k + 1, 4) = arr(a(0), 19)
    tmp = T
    ReDim b(1 To 3)
    
    For r = a(0) To a(1)
      key2 = key & arr(r, 17)
      If arr(r, 18) = T And dic.exists(key2) Then
        a = dic(key2)
        res(a(0), a(1)) = res(a(0), a(1)) + 1
      ElseIf tmp < T Then
        b(c) = b(c) + 1
        res(k + b(c), c * 3 + 3) = arr(r, 17)
        res(k + b(c), c * 3 + 4) = arr(r, 18)
        tmp = tmp - arr(r, 18)
        If tmp = 0 Then tmp = T
      Else
        cMax = 9999
        For j = 1 To 3 '****
          If cMax > b(j) Then cMax = b(j): c = j
        Next j
        b(c) = b(c) + 1
        res(k + b(c), c * 3 + 3) = arr(r, 17)
        res(k + b(c), c * 3 + 4) = arr(r, 18)
        tmp = tmp - arr(r, 18)
        If tmp = 0 Then tmp = T
        If arr(r, 18) = T And dic.exists(key2) = False Then
          res(k + b(c), c * 3 + 5) = 1
          dic(key2) = Array(k + b(c), c * 3 + 5)
        End If
      End If
    Next r
    cMax = 0
    For j = 1 To 3 '****
      If cMax < b(j) Then cMax = b(j): c = j
    Next j
    k = k + b(c)
  Next i
  Ws.Range("C4:P1000").Clear
  Ws.Range("C4").Resize(k, 14) = res
End Sub

 

[BuiQuangThuan]

Kiểm tra lại . . .

Option Explicit

Sub xyz()
  Dim arr(), ct(), a, b&(), res(), Ws As Worksheet, dic As Object, key$, key2$
  Dim srCT&, srArr&, i&, r&, k&, j&, c&
  Dim pallet&, T&, tmp&, inv$, sp&, cMax&
 
  ReDim res(1 To 100, 1 To 14)
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("Chung tu")
    ct = .Range("A4", .Range("E" & Rows.Count).End(3)).Value
  End With
  With Sheets("Data")
    arr = .Range("F3", .Range("X" & Rows.Count).End(3).Offset(1)).Value
  End With
  srCT = UBound(ct): srArr = UBound(arr) - 1
  arr(UBound(arr), 2) = "00000"
  arr(1, 2) = arr(1, 1) & "|" & CLng(Right(arr(1, 2), 4)) & "|" & arr(1, 3) 'key of dictionary
 
  For i = 1 To srArr
    arr(i + 1, 2) = arr(i + 1, 1) & "|" & CLng(Right(arr(i + 1, 2), 4)) & "|" & arr(i + 1, 3)
    If dic.exists(arr(i, 2)) = False Then dic.Add arr(i, 2), i
    If arr(i, 2) <> arr(i + 1, 2) Then
      dic(arr(i, 2)) = Array(dic(arr(i, 2)), i)
    End If
  Next i
  Set Ws = Sheets("Ket Qua")
  inv = Mid(Ws.Range("D2"), InStrRev(Ws.Range("D2"), " ") + 1)
 
  For i = 1 To srCT
    If pallet <> ct(i, 1) Then
      pallet = ct(i, 1)
      res(k + 1, 1) = pallet
    End If
    If sp <> ct(i, 2) Or pallet <> ct(i, 1) Then
      res(k + 1, 2) = ct(i, 2)
      res(k + 1, 3) = ct(i, 3)
      res(k + 1, 5) = ct(i, 5)
    End If
   
    T = ct(i, 3) / ct(i, 5) 'So SP/lot
    key = inv & "|" & pallet & "|" & ct(i, 2)
    a = dic(key)
    res(k + 1, 4) = arr(a(0), 19)
    tmp = T
    ReDim b(1 To 3)
   
    For r = a(0) To a(1)
      key2 = key & arr(r, 17)
      If arr(r, 18) = T And dic.exists(key2) Then
        a = dic(key2)
        res(a(0), a(1)) = res(a(0), a(1)) + 1
      ElseIf tmp < T Then
        b(c) = b(c) + 1
        res(k + b(c), c * 3 + 3) = arr(r, 17)
        res(k + b(c), c * 3 + 4) = arr(r, 18)
        tmp = tmp - arr(r, 18)
        If tmp = 0 Then tmp = T
      Else
        cMax = 9999
        For j = 1 To 3 '****
          If cMax > b(j) Then cMax = b(j): c = j
        Next j
        b(c) = b(c) + 1
        res(k + b(c), c * 3 + 3) = arr(r, 17)
        res(k + b(c), c * 3 + 4) = arr(r, 18)
        tmp = tmp - arr(r, 18)
        If tmp = 0 Then tmp = T
        If arr(r, 18) = T And dic.exists(key2) = False Then
          res(k + b(c), c * 3 + 5) = 1
          dic(key2) = Array(k + b(c), c * 3 + 5)
        End If
      End If
    Next r
    cMax = 0
    For j = 1 To 3 '****
      If cMax < b(j) Then cMax = b(j): c = j
    Next j
    k = k + b(c)
  Next i
  Ws.Range("C4:P1000").Clear
  Ws.Range("C4").Resize(k, 14) = res
End Sub

Cám ơn Thầy nhiều. Em sẽ kiểm tra lại kết quả rồi phản hồi lại sau ạ.