ตรวจความถูกต้องของจำนวนตัวเลข หากไม่ถูกต้องให้แสดง MsgBox

[Totem]

เรียนอาจารย์และเพื่อนสมาชิกทุกท่าน

ต้องการตรวจตัวเลข เซลล์ C2 ว่า เซลล์ J5:J12 และ J16:J18 ถูกต้องหรือไม่ หากไม่ตัวเลขตรงกับเซลล์ C2 ให้แสดง MsgBox ส่วนที่

ผิด ข้อที่ ผิด ถ้าถูกต้องก็ให้แสดงว่าถูกต้องทุกข้อ

ผมได้ลองเขียน VBA แล้วติดปัญหาที่จะขอให้แก้ไข ดังนี้

1.สามารถปรับ Code ให้สั้นลงได้ไหม

2.run แล้วพอพบข้อที่ไม่ตรงแล้ว ได้คำตอบแค่ 1 รายการ ต้องการให้ run เงื่อนไขจนจบ แล้วแสดง สรุปส่วนที่ และข้อที่ ไม่ถูกต้อง

เช่น ผิดส่วนที่ 1 ข้อที่ 2,3,7,8 และผิดส่วนที่ 2 ข้อที่ 2,3 เป็นต้น

Code: Select all

Sub Check()

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim n As Integer
Dim o As Integer
Dim p As Integer
Dim q As Integer
Dim r As Integer
Dim s As Integer
Dim t As Integer

    
     
    i = Worksheets("sheet1").Cells(2, 3).Value
    j = Worksheets("sheet1").Cells(5, 10).Value
    k = Worksheets("sheet1").Cells(6, 10).Value
    l = Worksheets("sheet1").Cells(7, 10).Value
    m = Worksheets("sheet1").Cells(8, 10).Value
    n = Worksheets("sheet1").Cells(9, 10).Value
    o = Worksheets("sheet1").Cells(10, 10).Value
    p = Worksheets("sheet1").Cells(11, 10).Value
    q = Worksheets("sheet1").Cells(12, 10).Value
    r = Worksheets("sheet1").Cells(16, 10).Value
    s = Worksheets("sheet1").Cells(17, 10).Value
    t = Worksheets("sheet1").Cells(18, 10).Value
    
        If i <> j Then
        
        MsgBox "ผิดส่วนที่ 1 ข้อที่ 1"
        
        ElseIf i <> k Then
        
        MsgBox "ผิดส่วนที่ 1 ข้อที่ 2"
        
        ElseIf i <> l Then
        
        MsgBox "ผิดส่วนที่ 1 ข้อที่ 3"
        
        ElseIf i <> m Then
        
        MsgBox "ผิดส่วนที่ 1 ข้อที่ 4"
        
        ElseIf i <> n Then
        
        MsgBox "ผิดส่วนที่ 1 ข้อที่ 5"
        
        ElseIf i <> o Then
        
        MsgBox "ผิดส่วนที่ 1 ข้อที่ 6"
        
        ElseIf i <> p Then
        
        MsgBox "ผิดส่วนที่ 1 ข้อที่ 7"
        
        ElseIf i <> q Then
        
        MsgBox "ผิดส่วนที่ 1 ข้อที่ 8"
        
        ElseIf i <> r Then
        
        MsgBox "ผิดส่วนที่ 2 ข้อที่ 1"

        ElseIf i <> s Then
        
        MsgBox "ผิดส่วนที่ 1 ข้อที่ 2"
        
        ElseIf i <> t Then
        
        MsgBox "ผิดส่วนที่ 1 ข้อที่ 3"
        
        Else
        
        MsgBox "ถูกต้องทุกข้อ"
        
        
    End If
            
End Sub

ขอบคุณครับ

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Sub test()
    Dim rall As Range, r As Range
    Dim sc As String, check As Boolean
    With Sheets(1)
        Set rall = .Range("b3", .Range("b" & Rows.Count).End(xlUp))
        For Each r In rall
            If InStr(r.Value, "ส่วนที่") Then
                sc = r.Value
            End If
            If r.Offset(0, 8) <> .Range("c2").Value And r.Offset(0, 8) <> "" Then
                MsgBox "ผิด" & sc & " " & "ข้อที่ " & r.Value
                check = True
            End If
        Next r
        If check = False Then
            MsgBox "ถูกทุกข้อ"
        End If
    End With
End Sub

[Totem]

ตัวอย่าง Code ครับ

Code: Select all

Sub test()
    Dim rall As Range, r As Range
    Dim sc As String, check As Boolean
    With Sheets(1)
        Set rall = .Range("b3", .Range("b" & Rows.Count).End(xlUp))
        For Each r In rall
            If InStr(r.Value, "ส่วนที่") Then
                sc = r.Value
            End If
            If r.Offset(0, 8) <> .Range("c2").Value And r.Offset(0, 8) <> "" Then
                MsgBox "ผิด" & sc & " " & "ข้อที่ " & r.Value
                check = True
            End If
        Next r
        If check = False Then
            MsgBox "ถูกทุกข้อ"
        End If
    End With
End Sub

ขอบคุณครับอาจารย์ ได้ตามต้องการครับ จะลองไปปรับใช้อีกครั้งครับ

[Totem]

เรียนอาจารย์และเพื่อนสมาชิก

มีตัวอย่างเพิ่มเติมที่ลองปรับไปใช้แล้ว ติดปัญหาครับ

Code: Select all

Sub test()
    Dim rall As Range, r As Range
    Dim sc As String, check As Boolean
    With Sheets(1)
        Set rall = .Range("b3", .Range("b" & Rows.Count).End(xlUp))
        For Each r In rall
            If InStr(r.Value, "ส่วนที่") Then
                sc = r.Value
            End If
            
            If r.Offset(0, 8) <> .Range("c2").Value And r.Offset(0, 8) <> "" Then
            
            Else
            
            If r.Offset(0, 7) <> .Range("c2").Value And r.Offset(0, 7) <> "" Then
            
            Else
            
            If r.Offset(0, 6) <> .Range("c2").Value And r.Offset(0, 6) <> "" Then
            
            Else
            
            If r.Offset(13, 11) <> .Range("c2").Value And r.Offset(13, 11) <> "" Then
            
                MsgBox "ผิด" & sc & " " & "ข้อที่ " & r.Value
                check = True
                
            End If
            
        Next r
        
        If check = False Then
            MsgBox "ถูกทุกข้อ"
        End If
    End With
End Sub

ติดปัญหาตรงที่ Next r

ขึ้นข้อความว่า

Compile error:

Next without For

ขออาจารย์และเพื่อนสมาชิก ช่วยปรับ Code ที่ไม่ถูกต้องให้เป็นตัวอย่างด้วยครับ

ขอบคุณครับ

[snasui]

ลองปรับเป็นด้านล่างครับ

Code: Select all

Sub test()
    Dim rall As Range, r As Range
    Dim sc As String, check As Boolean
    With Sheets(1)
        Set rall = .Range("b3", .Range("b" & Rows.Count).End(xlUp))
        For Each r In rall
            If InStr(r.Value, "ส่วนที่") Then
                sc = r.Value
            End If
            
            If r.Offset(0, 8) <> .Range("c2").Value And r.Offset(0, 8) <> "" Then
            
            ElseIf r.Offset(0, 7) <> .Range("c2").Value And r.Offset(0, 7) <> "" Then
            
            ElseIf r.Offset(0, 6) <> .Range("c2").Value And r.Offset(0, 6) <> "" Then
            
            ElseIf r.Offset(13, 11) <> .Range("c2").Value And r.Offset(13, 11) <> "" Then
        
                MsgBox "ผิด" & sc & " " & "ข้อที่ " & r.Value
                check = True
                
            End If
            
        Next r
        
        If check = False Then
            MsgBox "ถูกทุกข้อ"
        End If
    End With
End Sub

[Totem]

ลองปรับเป็นด้านล่างครับ

Code: Select all

Sub test()
    Dim rall As Range, r As Range
    Dim sc As String, check As Boolean
    With Sheets(1)
        Set rall = .Range("b3", .Range("b" & Rows.Count).End(xlUp))
        For Each r In rall
            If InStr(r.Value, "ส่วนที่") Then
                sc = r.Value
            End If
            
            If r.Offset(0, 8) <> .Range("c2").Value And r.Offset(0, 8) <> "" Then
            
            ElseIf r.Offset(0, 7) <> .Range("c2").Value And r.Offset(0, 7) <> "" Then
            
            ElseIf r.Offset(0, 6) <> .Range("c2").Value And r.Offset(0, 6) <> "" Then
            
            ElseIf r.Offset(13, 11) <> .Range("c2").Value And r.Offset(13, 11) <> "" Then
        
                MsgBox "ผิด" & sc & " " & "ข้อที่ " & r.Value
                check = True
                
            End If
            
        Next r
        
        If check = False Then
            MsgBox "ถูกทุกข้อ"
        End If
    End With
End Sub

อาจารย์ครับ ปรับแล้ว รันผ่าน แต่ไม่ได้ตามเงื่อนไข ได้ผลรับเป็นถูกทุกข้อ

[snasui]

หลัง Then ทุกตัว ต้องเขียนสิ่งที่ต้องการเข้าไปด้วยครับ Code ด้านบนผมปรับให้เป็นตาม Form ที่ควรจะเป็นเท่านั้นครับ

[Totem]

หลัง Then ทุกตัว ต้องเขียนสิ่งที่ต้องการเข้าไปด้วยครับ Code ด้านบนผมปรับให้เป็นตาม Form ที่ควรจะเป็นเท่านั้นครับ

จริงด้วยครับ จะไปเขียนปรับ Code เอง ขอบคุณครับ