Nhờ giúp đỡ Code VBA hiển thị Msg Box các lỗi nhập liệu sai so với yêu cầu.

[dungluyen2119]

Chào các Anh/Chị trên diễn đàn. Anh/Chị giúp em code VBA kiểm tra lỗi sau khi đã nhập dữ liệu xong Click vào Tool kiểm tra lỗi thì sẽ hiển thị Msg Box tấ cả các mã sản phẩm không có trong list sản phẩm thực tế với ạ. Em xin cảm ơn Anh/Chị rất nhiều ạ.

 

[Ronaldinho7]

Chào các Anh/Chị trên diễn đàn. Anh/Chị giúp em code VBA kiểm tra lỗi sau khi đã nhập dữ liệu xong Click vào Tool kiểm tra lỗi thì sẽ hiển thị Msg Box tấ cả các mã sản phẩm không có trong list sản phẩm thực tế với ạ. Em xin cảm ơn Anh/Chị rất nhiều ạ.
View attachment 290431

Sao không dùng datavalidation cho nó nhàn bạn

 

[dungluyen2119]

Sao không dùng datavalidation cho nó nhàn bạn

Dạ, tại vì em muốn áp dụng nó vào một file quản lý dữ liệu, nên em muốn được các Anh giúp đỡ code để gán vào file ạ.

 

[dangductuong2125]

Sử dụng tạm code này trong khi chờ code khác hay hơn :

Sub SoSanh_Ma_SP()
    Dim ws As Worksheet
    Dim range1 As Range, range2 As Range
    Dim cell As Range
    Dim missingValues As String
    Dim lookupRange As Range
    Dim dict As Object
    Dim i As Long
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set range1 = ws.Range("E4:E15")
    Set range2 = ws.Range("J4:J9")
    
    Set dict = CreateObject("Scripting.Dictionary")
    

    For Each cell In range2
        dict(cell.Value) = 1
    Next cell
    
  
    For Each cell In range1
        If Not dict.exists(cell.Value) Then
            missingValues = missingValues & cell.Value & vbCrLf
        End If
    Next cell
    

    For Each cell In range2
        If Not WorksheetFunction.CountIf(range1, cell.Value) > 0 Then
            missingValues = missingValues & cell.Value & vbCrLf
        End If
    Next cell
    
    If Len(missingValues) > 0 Then
        MsgBox "Danh sach ma khong co:" & vbCrLf & missingValues
    Else
        MsgBox "Khong co ma nao."
    End If
    
    Set dict = Nothing
End Sub

 

[dungluyen2119]

Sử dụng tạm code này trong khi chờ code khác hay hơn :

Sub SoSanh_Ma_SP()
    Dim ws As Worksheet
    Dim range1 As Range, range2 As Range
    Dim cell As Range
    Dim missingValues As String
    Dim lookupRange As Range
    Dim dict As Object
    Dim i As Long
   
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set range1 = ws.Range("E4:E15")
    Set range2 = ws.Range("J4:J9")
   
    Set dict = CreateObject("Scripting.Dictionary")
   

    For Each cell In range2
        dict(cell.Value) = 1
    Next cell
   
 
    For Each cell In range1
        If Not dict.exists(cell.Value) Then
            missingValues = missingValues & cell.Value & vbCrLf
        End If
    Next cell
   

    For Each cell In range2
        If Not WorksheetFunction.CountIf(range1, cell.Value) > 0 Then
            missingValues = missingValues & cell.Value & vbCrLf
        End If
    Next cell
   
    If Len(missingValues) > 0 Then
        MsgBox "Danh sach ma khong co:" & vbCrLf & missingValues
    Else
        MsgBox "Khong co ma nao."
    End If
   
    Set dict = Nothing
End Sub

Em cảm ơn Bác rất nhiều ạ.

 

[BuiQuangThuan]

Sử dụng tạm code này trong khi chờ code khác hay hơn :

Không nói hay dở hơn. Tham khảo thêm 1 cách khác

Sub ABC()
    Dim Dic As Object, sArr(), i&, Key$
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
        sArr = .Range("E4:E" & .Range("E" & Rows.Count).End(3).Row).Value
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) = False Then
                Dic.Add sArr(i, 1), ""
            End If
        Next
        sArr = .Range("J4:J" & .Range("J" & Rows.Count).End(3).Row).Value
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) = True Then
                Dic.Remove sArr(i, 1)
            End If
        Next
        Key = VBA.Join(Dic.keys, Chr(10))
        MsgBox Key, , "Thông Báo"
    End With
End Sub

 

[dungluyen2119]

Không nói hay dở hơn. Tham khảo thêm 1 cách khác

Sub ABC()
    Dim Dic As Object, sArr(), i&, Key$
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("Sheet1")
        sArr = .Range("E4:E" & .Range("E" & Rows.Count).End(3).Row).Value
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) = False Then
                Dic.Add sArr(i, 1), ""
            End If
        Next
        sArr = .Range("J4:J" & .Range("J" & Rows.Count).End(3).Row).Value
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) = True Then
                Dic.Remove sArr(i, 1)
            End If
        Next
        Key = VBA.Join(Dic.keys, Chr(10))
        MsgBox Key, , "Thông Báo"
    End With
End Sub

Cảm ơn bác BuiQuangThuan rất nhiều ạ. Tuyệt vời ạ