VBA để liệt kê các mã hàng dựa trên Barcode (1 người xem)

[tieuthubuongbinh]

Chào các bác,

Nhờ các bác làm giúp em bài này ạ:

Khách hàng dùng Barcode để đặt hàng (em gọi tắt là EAN), và hệ thống bên em chỉ hiểu SAP code (em gọi tắt là SAP), nên em cần phải biết là EAN được quy đổi thành SAP nào.
Vấn đề là 1 EAN có nhiều SAP. Và có trường hợp 1 EAN được merge thành 1 EAN khác (do cùng là 1 sản phẩm nhưng lại có 2 xuất xứ khác nhau). Điều này được định nghĩa trong sheet MM!D : Dlà EAN gốc, và em đã merge thành cột MM!AQ:AQ

Yêu cầu:
Khi khách hàng cung cấp EAN, em cần liệt kê có bao nhiêu SAP đang thỏa các điều kiện tại Report!B1:B2 (em đang vd max 4 cột)
Như vậy, trước tiên cần xem EAN đó đang được quy đổi thành EAN nào, nên cột Report!B:B sẽ so sánh MM!D: D với MM!AQ:AQ để lấy MM!AQ trả về Report!B:B,
*Trường hợp không đặc biệt:
Lấy MM!D: D làm chuẩn, để trả về giá trị tương ứng ở MM!AQ:AQ
*Trường hợp đặc biệt:
MM!D: D đang trùng với MM!AQ:AQ, mà MM!AQ:AQ lại có 1 EAN mà EAN được quy về nó, thì Report!B:B cần hiện EAN ở MM!D: D ra.
Vd được tô màu trong sheet MM
MM!D: D có 2 EAN mà được quy về 1 EAN trong MM!AQ:AQ, vậy thì nếu nhập liệu EAN này ở Report!A:A thì sẽ hiện EAN kia ở Report!B:B và ngược lại.
Còn nếu như EAN mà không bị thay đổi (MM!D: D=MM!AQ:AQ) thì coi như không phài trường hợp đặc biệt.
Sau khi đã có EAN ở Report!A:B thì hiện SAP cho các cột thỏa điều kiện ở Report!B1:B2

Em có ghi chú cụ thể cho từng trường hợp kết quả trả về, nhờ các bác xem giúp trong file.

Vấn đề có hơi phức tạp nên nếu còn gì vướng mắc, nhờ các bác hỏi thêm ạ.

Em cảm ơn.
Thân,
TTBB

 

[befaint]

Híc. Viết gì mà dài dóng thấy gớm. Đọc xong chóng mặt càng không hiểu gì.

"ko thỏa B1:B2" là gì?
"ca o" là gì? B1:B2 so sánh/ đối chiếu với cái gì?

[Compare] là gì? để làm gì? điền cái gì vào đó?

"Report!B:B" cái này ở đâu?

"MM" có thể đổi tên sheet thành cái gì đó liên tưởng nội dung gì cụ thể không? Mờ mờ thấy mờ mờ làm sao ấy.

 

[ptm0412]

Làm trước hàm tính cột B:
B6 = ConvertEAN(A6)
Gắn SAP mai làm

Function ConvertEAN(EAN) As String
ConvertEAN = ""
Dim check As Boolean, i As Long, k As Long
Dim LastDataRw As Long, EAN1(), EAN2(), DataTmp()
LastDataRw = Sheet2.[D1000].End(xlUp).Row
EAN1 = Sheet2.Range("D2:D" & LastDataRw).Value2
EAN2 = Sheet2.Range("AQ2:AQ" & LastDataRw).Value2
ReDim DataTmp(1 To 10, 1 To 2)
For i = 1 To UBound(EAN1, 1)
    If EAN1(i, 1) = EAN Or EAN2(i, 1) = EAN Then
        k = k + 1
        DataTmp(k, 1) = EAN1(i, 1)
        DataTmp(k, 2) = EAN2(i, 1)
    End If
Next
If k = 0 Then ConvertEAN = "NA": Exit Function
For i = 1 To k
    If DataTmp(i, 2) = DataTmp(i, 1) Then
        check = True
    Else
        check = False
        ConvertEAN = IIf(DataTmp(i, 2) = EAN, DataTmp(i, 1), DataTmp(i, 2))
        Exit Function
    End If
Next
If ConvertEAN = "" And check = True Then ConvertEAN = EAN
End Function

 

[ThangCuAnh]

Bác @ptm0412 đã dùng Value2 rồi mà EAN1, EAN2 vẫn dùng () hen

 

[ptm0412]

Híc. Viết gì mà dài dóng thấy gớm. Đọc xong chóng mặt càng không hiểu gì.
"ko thỏa B1:B2" là gì?
"ca o" là gì? B1:B2 so sánh/ đối chiếu với cái gì?
[Compare] là gì? để làm gì? điền cái gì vào đó?
"Report!B:B" cái này ở đâu?
"MM" có thể đổi tên sheet thành cái gì đó liên tưởng nội dung gì cụ thể không? Mờ mờ thấy mờ mờ làm sao ấy.

- B1:B2: so sánh cột E sheet MM với B1 và B2 ("Cột E sheet MM" đọc mãi tới dòng cuối trong file mới thấy). Nhưng không biết And hay Or, nếu And thì chết ngắc mà Or thì dữ liệu mẫu sai sai.
- [Compare] là cột B và phải tìm kiếm để điền vào, người dùng chỉ điền cột A. Cũng đọc mãi mới hiểu
- "Report!B:B" ở đâu: Chẳng có trên đời, do đó cứ coi như "sheet1"

Tóm lại là viết cái hàm 30' mà phải đọc đề cũng 30'

 

[HieuCD]

Chào các bác,

Nhờ các bác làm giúp em bài này ạ:

Khách hàng dùng Barcode để đặt hàng (em gọi tắt là EAN), và hệ thống bên em chỉ hiểu SAP code (em gọi tắt là SAP), nên em cần phải biết là EAN được quy đổi thành SAP nào.
Vấn đề là 1 EAN có nhiều SAP. Và có trường hợp 1 EAN được merge thành 1 EAN khác (do cùng là 1 sản phẩm nhưng lại có 2 xuất xứ khác nhau). Điều này được định nghĩa trong sheet MM!D : Dlà EAN gốc, và em đã merge thành cột MM!AQ:AQ

Yêu cầu:
Khi khách hàng cung cấp EAN, em cần liệt kê có bao nhiêu SAP đang thỏa các điều kiện tại Report!B1:B2 (em đang vd max 4 cột)
Như vậy, trước tiên cần xem EAN đó đang được quy đổi thành EAN nào, nên cột Report!B:B sẽ so sánh MM!D: D với MM!AQ:AQ để lấy MM!AQ trả về Report!B:B,
*Trường hợp không đặc biệt:
Lấy MM!D: D làm chuẩn, để trả về giá trị tương ứng ở MM!AQ:AQ
*Trường hợp đặc biệt:
MM!D: D đang trùng với MM!AQ:AQ, mà MM!AQ:AQ lại có 1 EAN mà EAN được quy về nó, thì Report!B:B cần hiện EAN ở MM!D: D ra.
Vd được tô màu trong sheet MM
MM!D: D có 2 EAN mà được quy về 1 EAN trong MM!AQ:AQ, vậy thì nếu nhập liệu EAN này ở Report!A:A thì sẽ hiện EAN kia ở Report!B:B và ngược lại.
Còn nếu như EAN mà không bị thay đổi (MM!D: D=MM!AQ:AQ) thì coi như không phài trường hợp đặc biệt.
Sau khi đã có EAN ở Report!A:B thì hiện SAP cho các cột thỏa điều kiện ở Report!B1:B2

Em có ghi chú cụ thể cho từng trường hợp kết quả trả về, nhờ các bác xem giúp trong file.

Vấn đề có hơi phức tạp nên nếu còn gì vướng mắc, nhờ các bác hỏi thêm ạ.

Em cảm ơn.
Thân,
TTBB

Tạo sự kiện thay đổi B1:B2 và nút chạy code

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("B1:B2")) Is Nothing Then
    If IsNumeric(Range("B1").Value) And IsNumeric(Range("B2").Value) Then
      Call ABC
    End If
  End If
End Sub

Sub ABC()
  Dim sArr(), dArr(), dArr2(), Res(), S, Dic As Object
  Dim iKey As String, iKey2 As String, tmp As String
  Dim i&, sR&, sR2&, j&, k&, ik&, c&
  Dim iMin As Long, iMax As Long
  With Sheet1
    sArr = .Range("A6:A" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    iMin = .Range("B2").Value
    iMax = .Range("B1").Value
  End With
  With Sheet2
    dArr = .Range("A2:E" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    dArr2 = .Range("AQ2:AQ" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
 
  Set Dic = CreateObject("scripting.dictionary")
  sR2 = UBound(dArr)
  For i = 1 To sR2
    iKey = dArr(i, 4)
    Dic.Item(iKey) = Dic.Item(iKey) & "," & i
    If iKey <> dArr2(i, 1) Then
      iKey2 = iKey & "#"
      If Dic.exists(iKey2) = False Then
        Dic.Add iKey2, dArr2(i, 1)
      End If
      iKey2 = dArr2(i, 1) & "#"
      If Dic.exists(iKey2) = False Then
        Dic.Add iKey2, dArr(i, 4)
      End If
    End If
  Next i

  sR = UBound(sArr)
  ReDim Res(1 To sR, 1 To 5)
  For i = 1 To sR
    tmp = Dic.Item(sArr(i, 1))
    If Len(tmp) > 1 Then
      S = Split(Dic.Item(sArr(i, 1)), ",")
      iKey2 = dArr(CLng(S(1)), 4) & "#"
      If Dic.exists(iKey2) = True Then
        Res(i, 1) = Dic.Item(iKey2)
      Else
        Res(i, 1) = sArr(i, 1)
      End If
      c = 1
      For j = 1 To UBound(S)
        ik = CLng(S(j))
        If dArr(ik, 5) >= iMin And dArr(ik, 5) <= iMax Then
          c = c + 1
          Res(i, c) = dArr(ik, 1)
        End If
      Next j
      If Res(i, 1) <> sArr(i, 1) Then
        S = Split(Dic.Item(Res(i, 1)), ",")
        For j = 1 To UBound(S)
          ik = CLng(S(j))
          If dArr(ik, 5) >= iMin And dArr(ik, 5) <= iMax Then
            c = c + 1
            Res(i, c) = dArr(ik, 1)
          End If
        Next j
      End If
    Else
      Res(i, 1) = "NA"
    End If
  Next i
 
  With Sheet1
    .Range("B6").Resize(sR).NumberFormat = "@"
    .Range("B6").Resize(sR, 5) = Res
  End With
End Sub

 

[tieuthubuongbinh]

Híc. Viết gì mà dài dóng thấy gớm. Đọc xong chóng mặt càng không hiểu gì.

"ko thỏa B1:B2" là gì?
"ca o" là gì? B1:B2 so sánh/ đối chiếu với cái gì?

[Compare] là gì? để làm gì? điền cái gì vào đó?

"Report!B:B" cái này ở đâu?

"MM" có thể đổi tên sheet thành cái gì đó liên tưởng nội dung gì cụ thể không? Mờ mờ thấy mờ mờ làm sao ấy.

bác @ptm0412 hiểu đúng ý mình rồi. Chỉ là tên sheet thôi mà, bác cứ mặc kệ đi. Em phải ghi tên sheet như vầy vì nó có dính dáng code khác của em (ko sửa được)

Làm trước hàm tính cột B:
B6 = ConvertEAC(A6)
Gắn SAP mai làm

Ủa ko có sub sao con gắn vào nút chạy macro được vậy bác? à bác ơi, A1 bác thay less than và A2 là greater than giùm con nha, con ghi bị ngược

Bài đã được tự động gộp: 11/8/19

- B1:B2: so sánh cột E sheet MM với B1 và B2 ("Cột E sheet MM" đọc mãi tới dòng cuối trong file mới thấy). Nhưng không biết And hay Or, nếu And thì chết ngắc mà Or thì dữ liệu mẫu sai sai.
- [Compare] là cột B và phải tìm kiếm để điền vào, người dùng chỉ điền cột A. Cũng đọc mãi mới hiểu
- "Report!B:B" ở đâu: Chẳng có trên đời, do đó cứ coi như "sheet1"

Tóm lại là viết cái hàm 30' mà phải đọc đề cũng 30'

And nha bác và con viết ngươc hihi
Bác Mỹ thông minh quá chừng luôn hihi. Con đổi tên sheet1 thành report rồi mà sao lúc gửi file nó ko đổi nhỉ. Nhưng mà bác quá đỉnh , mà bác ơi, con chỉnh cái B1 và B2 thì bác có phải sửa code lại ko bác? vì con đưa vào file thật thì nó ko ra

Bài đã được tự động gộp: 11/8/19

Tạo sự kiện thay đổi B1:B2 và nút chạy code

Em chạy được code rồi và thấy ổn, nhưng lên file thật nó báo lỗi dòng này:

 

[ptm0412]

Lỡ viết hàm nên GetSAP cũng dựa theo hàm này. Dữ liệu theo tôi biết thì barcode sẽ có dạng số thì phải.

Sub GetSAPs()
Dim i As Long, k As Long, ECnt As Long
Dim LastDataRw As Long, EAN1, EAN2, DataTmp(), SPec, Material
Dim LastEANRw As Long, EANArr
Dim minSpec As Long, maxSpec As Long
Dim EAN As String, ResultArr()
'Sheet MM'
LastDataRw = Sheet2.[D50000].End(xlUp).Row
EAN1 = Sheet2.Range("D2:D" & LastDataRw).Value2
EAN2 = Sheet2.Range("AQ2:AQ" & LastDataRw).Value2
SPec = Sheet2.Range("E2:E" & LastDataRw).Value2
Material = Sheet2.Range("A2:A" & LastDataRw).Value2
'Sheet Report'
LastEANRw = Sheet1.[A50000].End(xlUp).Row
EANArr = Sheet1.Range("A6:A" & LastEANRw).Value2
minSpec = Sheet1.[B2]: maxSpec = Sheet1.[B1]
ReDim ResultArr(1 To UBound(EANArr, 1), 1 To 10)
'Main code'
For ECnt = 1 To UBound(EANArr, 1)
    x = 1
    j = j + 1
    'Get DataTmp
    EAN = EANArr(ECnt, 1)
    ReDim DataTmp(1 To 10, 1 To 4)
    ResultArr(j, 1) = ConvertEAN(Val(EAN))
    k = 0
    For i = 1 To UBound(EAN1, 1)
        If EAN1(i, 1) = EAN Or EAN1(i, 1) = ResultArr(j, 1) Then
            k = k + 1
            DataTmp(k, 1) = EAN1(i, 1)
            DataTmp(k, 2) = EAN2(i, 1)
            DataTmp(k, 3) = SPec(i, 1)
            DataTmp(k, 4) = Material(i, 1)
        End If
    Next
    If k > 0 Then
    For i = 1 To k
        If DataTmp(i, 3) < maxSpec And DataTmp(i, 3) > minSpec Then
            x = x + 1
            ResultArr(j, x) = DataTmp(i, 4)
        End If
    Next
    End If
Next

Sheet1.[B6].Resize(j, 10) = ResultArr

End Sub

 

[HieuCD]

bác @ptm0412 hiểu đúng ý mình rồi. Chỉ là tên sheet thôi mà, bác cứ mặc kệ đi. Em phải ghi tên sheet như vầy vì nó có dính dáng code khác của em (ko sửa được)


Ủa ko có sub sao con gắn vào nút chạy macro được vậy bác? à bác ơi, A1 bác thay less than và A2 là greater than giùm con nha, con ghi bị ngược

Bài đã được tự động gộp: 11/8/19

And nha bác và con viết ngươc hihi
Bác Mỹ thông minh quá chừng luôn hihi. Con đổi tên sheet1 thành report rồi mà sao lúc gửi file nó ko đổi nhỉ. Nhưng mà bác quá đỉnh , mà bác ơi, con chỉnh cái B1 và B2 thì bác có phải sửa code lại ko bác? vì con đưa vào file thật thì nó ko ra

Bài đã được tự động gộp: 11/8/19

Em chạy được code rồi và thấy ổn, nhưng lên file thật nó báo lỗi dòng này:

Chỉnh lại tên sheet phù hợp với file thực tế

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("B1:B2")) Is Nothing Then
    If IsNumeric(Range("B1").Value) And IsNumeric(Range("B2").Value) Then
      Call ABC
    End If
  End If
End Sub

Sub ABC()
  Dim sArr(), dArr(), dArr2(), Res(), S, Dic As Object
  Dim iKey As String, iKey2 As String, tmp As String
  Dim i&, sR&, sR2&, j&, k&, ik&, c&
  Dim iMin As Long, iMax As Long
  With Sheets("Sheet1") '  "Sheet1": Ten Sheet Ket Qua
    sArr = .Range("A6:A" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    iMin = .Range("B2").Value
    iMax = .Range("B1").Value
  End With
  With Sheets("MM") '  "MM":  Ten Sheet Du Lieu
    dArr = .Range("A2:E" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    dArr2 = .Range("AQ2:AQ" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
 
  Set Dic = CreateObject("scripting.dictionary")
  sR2 = UBound(dArr)
  For i = 1 To sR2
    iKey = dArr(i, 4)
    Dic.Item(iKey) = Dic.Item(iKey) & "," & i
    If iKey <> dArr2(i, 1) Then
      iKey2 = iKey & "#"
      If Dic.exists(iKey2) = False Then
        Dic.Add iKey2, dArr2(i, 1)
      End If
      iKey2 = dArr2(i, 1) & "#"
      If Dic.exists(iKey2) = False Then
        Dic.Add iKey2, dArr(i, 4)
      End If
    End If
  Next i

  sR = UBound(sArr)
  ReDim Res(1 To sR, 1 To 5)
  For i = 1 To sR
    tmp = Dic.Item(sArr(i, 1))
    If Len(tmp) > 1 Then
      S = Split(Dic.Item(sArr(i, 1)), ",")
      iKey2 = dArr(CLng(S(1)), 4) & "#"
      If Dic.exists(iKey2) = True Then
        Res(i, 1) = Dic.Item(iKey2)
      Else
        Res(i, 1) = sArr(i, 1)
      End If
      c = 1
      For j = 1 To UBound(S)
        ik = CLng(S(j))
        If dArr(ik, 5) >= iMin And dArr(ik, 5) <= iMax Then
          c = c + 1
          Res(i, c) = dArr(ik, 1)
        End If
      Next j
      If Res(i, 1) <> sArr(i, 1) Then
        S = Split(Dic.Item(Res(i, 1)), ",")
        For j = 1 To UBound(S)
          ik = CLng(S(j))
          If dArr(ik, 5) >= iMin And dArr(ik, 5) <= iMax Then
            c = c + 1
            Res(i, c) = dArr(ik, 1)
          End If
        Next j
      End If
    Else
      Res(i, 1) = "NA"
    End If
  Next i
 
  With Sheets("Sheet1")'   "Sheet1": Ten Sheet Ket Qua
    .Range("B6").Resize(sR).NumberFormat = "@"
    .Range("B6").Resize(sR, 5) = Res
  End With
End Sub

 

[tieuthubuongbinh]

Chỉnh lại tên sheet phù hợp với file thực tế

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("B1:B2")) Is Nothing Then
    If IsNumeric(Range("B1").Value) And IsNumeric(Range("B2").Value) Then
      Call ABC
    End If
  End If
End Sub

Sub ABC()
  Dim sArr(), dArr(), dArr2(), Res(), S, Dic As Object
  Dim iKey As String, iKey2 As String, tmp As String
  Dim i&, sR&, sR2&, j&, k&, ik&, c&
  Dim iMin As Long, iMax As Long
  With Sheets("Sheet1") '  "Sheet1": Ten Sheet Ket Qua
    sArr = .Range("A6:A" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    iMin = .Range("B2").Value
    iMax = .Range("B1").Value
  End With
  With Sheets("MM") '  "MM":  Ten Sheet Du Lieu
    dArr = .Range("A2:E" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    dArr2 = .Range("AQ2:AQ" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With

  Set Dic = CreateObject("scripting.dictionary")
  sR2 = UBound(dArr)
  For i = 1 To sR2
    iKey = dArr(i, 4)
    Dic.Item(iKey) = Dic.Item(iKey) & "," & i
    If iKey <> dArr2(i, 1) Then
      iKey2 = iKey & "#"
      If Dic.exists(iKey2) = False Then
        Dic.Add iKey2, dArr2(i, 1)
      End If
      iKey2 = dArr2(i, 1) & "#"
      If Dic.exists(iKey2) = False Then
        Dic.Add iKey2, dArr(i, 4)
      End If
    End If
  Next i

  sR = UBound(sArr)
  ReDim Res(1 To sR, 1 To 5)
  For i = 1 To sR
    tmp = Dic.Item(sArr(i, 1))
    If Len(tmp) > 1 Then
      S = Split(Dic.Item(sArr(i, 1)), ",")
      iKey2 = dArr(CLng(S(1)), 4) & "#"
      If Dic.exists(iKey2) = True Then
        Res(i, 1) = Dic.Item(iKey2)
      Else
        Res(i, 1) = sArr(i, 1)
      End If
      c = 1
      For j = 1 To UBound(S)
        ik = CLng(S(j))
        If dArr(ik, 5) >= iMin And dArr(ik, 5) <= iMax Then
          c = c + 1
          Res(i, c) = dArr(ik, 1)
        End If
      Next j
      If Res(i, 1) <> sArr(i, 1) Then
        S = Split(Dic.Item(Res(i, 1)), ",")
        For j = 1 To UBound(S)
          ik = CLng(S(j))
          If dArr(ik, 5) >= iMin And dArr(ik, 5) <= iMax Then
            c = c + 1
            Res(i, c) = dArr(ik, 1)
          End If
        Next j
      End If
    Else
      Res(i, 1) = "NA"
    End If
  Next i

  With Sheets("Sheet1")'   "Sheet1": Ten Sheet Ket Qua
    .Range("B6").Resize(sR).NumberFormat = "@"
    .Range("B6").Resize(sR, 5) = Res
  End With
End Sub

Em biết chút chút nên tên sheet thì em chỉnh được và đúng theo file thât nhưng nó vẫn báo lỗi chỗ đó đó anh (rồi em lưu thử 1 file cũng chỉ có 2 sheet giống file giả lập, nhưng MM là data thật thì nó cũng báo lỗi đúng chỗ đó)

 

[HieuCD]

Em biết chút chút nên tên sheet thì em chỉnh được và đúng theo file thât nhưng nó vẫn báo lỗi chỗ đó đó anh (rồi em lưu thử 1 file cũng chỉ có 2 sheet giống file giả lập, nhưng MM là data thật thì nó cũng báo lỗi đúng chỗ đó)

Có thể cột dữ liệu không đúng, Gởi file thật với dữ liệu giả định lên

 

[tieuthubuongbinh]

Có thể cột dữ liệu không đúng, Gởi file thật với dữ liệu giả định lên

File thật của em link nhiều thứ và nhiều code lắm, em ko gửi lên đây được ạ. Còn file em thử dùng 2 sheets y như file giả lập nhưng dùng code ADO để gọi MM lên thì cũng bị lỗi. Để mai em làm thử lại coi sao, có gì em gửi lại file đó ạ

 

[ptm0412]

Có thể cột dữ liệu không đúng, Gởi file thật với dữ liệu giả định lên

Tôi cũng thấy vậy nên đang viết code cho dữ liêu number, dữ liệu text sẽ bị lỗi

 

[tieuthubuongbinh]

Data của con đã được chuẩn hoá về text rồi bác @ptm0412 bai này đã giải được rồi ạ. Sắp tới có bước 2 nữa con lại nhờ bác nha hihi

Cám ơn anh @HieuCD bác @ptm0412 rất nhiều