xin code về kiểm tra dữ liệu

[Tân Trần 89]

hiện tại mình cần kiểm tra những mã sản phẩm đã có trong dữ liệu bằng VBA như file kèm, mong các ace chỉ giúp.
sheet1 là dữ liệu cần kiểm tra, nếu có thì cột B kế bên sẽ hiện OK, nếu không có dữ liệu hiện NOT OK
sheet data chứa dữ liệu tổng.

Mong các ace chỉ giúp code ạ

 

[giaiphap]

hiện tại mình cần kiểm tra những mã sản phẩm đã có trong dữ liệu bằng VBA như file kèm, mong các ace chỉ giúp.
sheet1 là dữ liệu cần kiểm tra, nếu có thì cột B kế bên sẽ hiện OK, nếu không có dữ liệu hiện NOT OK
sheet data chứa dữ liệu tổng.

Mong các ace chỉ giúp code ạ

Dùng code này/

Private Function Check_Value(s As String, Rng As Range) As String
    If Application.WorksheetFunction.CountIf(Rng, s) > 0 Then
        Check_Value = "OK"
    Else
        Check_Value = "NOT OK"
    End If
End Function

Public Sub GPE()
    Dim Arr, i%, Rng As Range
    Arr = Sheet1.Range("A1:B" & Sheet1.Range("A1000000").End(xlUp).Row).Value
    Set Rng = Sheet2.Range("A1:A" & Sheet2.Range("A1000000").End(xlUp).Row)
    For i = 1 To UBound(Arr)
        Arr(i, 2) = Check_Value(CStr(Arr(i, 1)), Rng)
    Next i
    Sheet1.Range("A1:B" & UBound(Arr)).Value = Arr
    MsgBox "Finish"
End Sub

 

[Tân Trần 89]

Dùng code này/

Private Function Check_Value(s As String, Rng As Range) As String
    If Application.WorksheetFunction.CountIf(Rng, s) > 0 Then
        Check_Value = "OK"
    Else
        Check_Value = "NOT OK"
    End If
End Function

Public Sub GPE()
    Dim Arr, i%, Rng As Range
    Arr = Sheet1.Range("A1:B" & Sheet1.Range("A1000000").End(xlUp).Row).Value
    Set Rng = Sheet2.Range("A1:A" & Sheet2.Range("A1000000").End(xlUp).Row)
    For i = 1 To UBound(Arr)
        Arr(i, 2) = Check_Value(CStr(Arr(i, 1)), Rng)
    Next i
    Sheet1.Range("A1:B" & UBound(Arr)).Value = Arr
    MsgBox "Finish"
End Sub

Mình làm được rồi. Cảm ơn bạn rất nhiều!

 

[SA_DQ]

Thêm 1 phần vui vẻ nè:

Sub KiemTraMaSFDaCo()
 Dim Rng As Range, sRng As Range, Arr()
 Dim J As Long
 
 With Sheets("Data")
    Set Rng = .[A2].CurrentRegion
 End With
 Arr() = Sheet1.[A2].CurrentRegion.Resize(, 2).Value
 For J = 1 To UBound(Arr())
    Set sRng = Rng.Find(Arr(J, 1), , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        Arr(J, 2) = "Not Ok"
    Else
        Arr(J, 2) = "OK"
    End If
 Next J
 Sheet1.[A1].Resize(J - 1, 2).Value = Arr()
End Sub

 

[dongducnhiem]

Dùng code này/

Private Function Check_Value(s As String, Rng As Range) As String
    If Application.WorksheetFunction.CountIf(Rng, s) > 0 Then
        Check_Value = "OK"
    Else
        Check_Value = "NOT OK"
    End If
End Function

Public Sub GPE()
    Dim Arr, i%, Rng As Range
    Arr = Sheet1.Range("A1:B" & Sheet1.Range("A1000000").End(xlUp).Row).Value
    Set Rng = Sheet2.Range("A1:A" & Sheet2.Range("A1000000").End(xlUp).Row)
    For i = 1 To UBound(Arr)
        Arr(i, 2) = Check_Value(CStr(Arr(i, 1)), Rng)
    Next i
    Sheet1.Range("A1:B" & UBound(Arr)).Value = Arr
    MsgBox "Finish"
End Sub

Vui lòng cho hỏi
Nếu không cần "OK" hay "NOT OK" mà muốn chữ đỏ trên sản phẩm thì làm sao?
cảm ơn các bạn

 

[SA_DQ]

Vui lòng cho hỏi
Nếu không cần "OK" hay "NOT OK" mà muốn chữ đỏ trên sản phẩm thì làm sao? cảm ơn các bạn

Vậy thì trãi qua các bước sau:

1 (Chuẩn bị): Dữ liệu (DL) trên Sheet1 cần tô màu trắng
2. Đưa DL ở trang kia vô mảng
3. Tạo vòng lặp duyết DL ở Sheet1
4. Tạo vòng lặp duyệt mãng DL
Xác định tô màu ô đang duyệt (tại Sheet1) khi DL ô này có (hay không) ờ mãng

Chúc thành công!

 

[giaiphap]

Vui lòng cho hỏi
Nếu không cần "OK" hay "NOT OK" mà muốn chữ đỏ trên sản phẩm thì làm sao?
cảm ơn các bạn

Dùng code này.

Private Function Check_Value(s As String, Rng As Range) As Boolean
    If Application.WorksheetFunction.CountIf(Rng, s) > 0 Then
        Check_Value = True
    Else
        Check_Value = False
    End If
End Function

Public Sub GPE()
    Dim sCell As Range, dkCell As Range, Rng As Range, sRng As Range
    Set sRng = Sheet1.Range("A1:A" & Sheet1.Range("A1000000").End(xlUp).Row)
    sRng.Font.Color = RGB(0, 0, 0)
    Set Rng = Sheet2.Range("A1:A" & Sheet2.Range("A1000000").End(xlUp).Row)
    For Each sCell In sRng
        If Check_Value(CStr(sCell.Value), Rng) Then
          If dkCell Is Nothing Then
            Set dkCell = sCell
          Else
            Set dkCell = Union(sCell, dkCell)
          End If
        End If
    Next sCell
    If Not dkCell Is Nothing Then dkCell.Font.Color = RGB(255, 0, 0)
End Sub

 

[dongducnhiem]

Xin cảm ơn các bạn!

 

[Tân Trần 89]

Thêm 1 phần vui vẻ nè:

Sub KiemTraMaSFDaCo()
Dim Rng As Range, sRng As Range, Arr()
Dim J As Long

With Sheets("Data")
    Set Rng = .[A2].CurrentRegion
End With
Arr() = Sheet1.[A2].CurrentRegion.Resize(, 2).Value
For J = 1 To UBound(Arr())
    Set sRng = Rng.Find(Arr(J, 1), , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        Arr(J, 2) = "Not Ok"
    Else
        Arr(J, 2) = "OK"
    End If
Next J
Sheet1.[A1].Resize(J - 1, 2).Value = Arr()
End Sub

Cảm ơn bạn rất nhiều! Cảm ơn bạn rất nhiều!