ตั้งเงื่อนไขว่าถ้าค่าซ้ำให้แจ้งเตือนแต่เวลาไม่เจอค่าซ้ำกลับแจ้งเตือนเหมือนกัน

[apforever]

เงื่อนไขคือเวลา add ข้อมูลไปแล้วถ้ามีค่าซ้ำกันจะแจ้ง msgbox ถ้าไม่ซ้ำก็สามารถ add ได้ตามปกติ แต่พบปัญหาว่าพบค่าซ้ำหรือไม่ซ้ำก็แจ้ง msgbox ตลอด ลองพยายามแก้ code สรุปว่าพบค่าซ้ำหรือไม่ซ้ำ msgbox ก็จะไม่ขึ้นทั้งคู่ รบกวนดู code ให้หน่อยครับว่าควรปรับตรงไหนอย่างไรบ้าง ขอบคุณครับ

รูปประกอบครับ
https://www.picz.in.th/image/11111.tdgaHg
https://www.picz.in.th/image/22222.tdizIR

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Range("EMP_NO")) = "" Then Exit Sub
    If Not Intersect(Target, Range("EMP_NO")) Is Nothing Then
        If Len(Intersect(Target, Range("EMP_NO"))) <> 6 Then
        MsgBox "กรุณาใส่ Emp No. ให้ถูกต้อง", vbCritical, "Denied Access"
        Intersect(Target, Range("EMP_NO")).Select
        Intersect(Target, Range("EMP_NO")).Value = ""
        Else
            If Not IsNumeric(Intersect(Target, Range("EMP_NO"))) Then
            MsgBox "กรุณาใส่ Emp No. ให้ถูกต้อง", vbCritical, "Denied Access"
            Intersect(Target, Range("EMP_NO")).Select
            Intersect(Target, Range("EMP_NO")).Value = ""
                Else
                Dim rows1, i As Long
                rows1 = Sheets("Sheet1").Range("A1").CurrentRegion.Rows.Count
                For i = 2 To rows1
                If Sheets("Sheet1").Cells(i, 1) = Intersect(Target, Range("EMP_NO")) Then
                Sheets("Sheet1").Cells(i, 1).Select
                Intersect(Target, Range("EMP_NO")) = ""
                Dim msgbox1 As Integer
                msgbox1 = MsgBox("Emp No. หมายเลข : " & Sheets("Sheet1").Cells(i, 1).Value & " มีอยู่ในระบบแล้ว ต้องการเปลี่ยนแปลงค่า Name หรือไม่", vbYesNo, "Denied Access")
                    If msgbox1 = vbYes Then
                    Dim msgbox2 As Variant
                    msgbox2 = InputBox("กรุณาใส่ค่าที่ต้องการ", "Input Data")
                    Sheets("Sheet1").Cells(i, 2) = msgbox2
                    End If
                Exit For
                End If
                Next i
            End If
        End If
    End If
End Sub

[snasui]

ผมไม่ดูภาพที่แนบไว้ที่อื่น กรุณาอ่านกฎการใช้บอร์ดข้อ 4 ด้านบนอีกครั้งครับ

ตัวอย่าง Code การตรวจสอบว่าซ้ำหรือไม่ซ้ำ หากซ้ำจะมีการถามว่ายอมให้ซ้ำหรือไม่

Code: Select all

Dim rngEmpAll As Range, rsp As Integer
Dim iCount As Integer
If Target.Value = "" Then Exit Sub
With Me
    Set rngEmpAll = .Range("b2", .Range("b" & .Rows.Count) _
        .End(xlUp)).Offset(0, -1)
    For Each Rng In rngEmpAll
        If CStr(Target.Value) = CStr(Rng.Value) Then
            iCount = iCount + 1
        End If
    Next Rng
    If iCount > 0 Then
        rsp = MsgBox("Duplicate! Need to record?", vbYesNo, vbExclamation)
        If rsp = vbNo Then Target.ClearContents
    End If
End With

ลักษณะงานเช่นนี้ไม่จำเป็นต้องใช้ VBA ควรใช้ Validation แทนจะสะดวกและง่ายกว่ากันมากครับ

[apforever]

ผมไม่ดูภาพที่แนบไว้ที่อื่น กรุณาอ่านกฎการใช้บอร์ดข้อ 4 ด้านบนอีกครั้งครับ

ตัวอย่าง Code การตรวจสอบว่าซ้ำหรือไม่ซ้ำ หากซ้ำจะมีการถามว่ายอมให้ซ้ำหรือไม่

Code: Select all

Dim rngEmpAll As Range, rsp As Integer
Dim iCount As Integer
If Target.Value = "" Then Exit Sub
With Me
    Set rngEmpAll = .Range("b2", .Range("b" & .Rows.Count) _
        .End(xlUp)).Offset(0, -1)
    For Each Rng In rngEmpAll
        If CStr(Target.Value) = CStr(Rng.Value) Then
            iCount = iCount + 1
        End If
    Next Rng
    If iCount > 0 Then
        rsp = MsgBox("Duplicate! Need to record?", vbYesNo, vbExclamation)
        If rsp = vbNo Then Target.ClearContents
    End If
End With

ลักษณะงานเช่นนี้ไม่จำเป็นต้องใช้ VBA ควรใช้ Validation แทนจะสะดวกและง่ายกว่ากันมากครับ

ขอโทษที่ทำผิดกฏครับ และขอบคุณครับสำหรับคำแนะนำจะลองนำไปปรับใช้ดูครับ