Snasui Excel Forum

Code: Select all

Sub check_data()
        Range("b4").Select
        Cells.Find(What:="*และ หักนอก", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        Selection.Offset(0, 2).Select
        If Selection.Value = "" Then
        MsgBox "กรอกจำนวนเงินที่ต้องการหักในช่องนี้"
        Exit Sub
        Else
        Selection.Offset(0, -2).Select
        Cells.Find(What:="*และ หักนอก", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        Selection.Offset(0, 2).Select
        If Selection.Value <> "" Then
        Exit Sub
        End If
        End If
End Sub

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errorline
    If Target.Column = 4 Then
        Selection.Offset(0, -2).Select
        Cells.Find(What:="*และ หักนอก", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        Selection.Offset(0, 2).Select
        If Selection.Value = "" Then
        MsgBox "กรอกจำนวนเงินที่ต้องการหักในช่องนี้"
        Else
        Selection.Offset(0, -2).Select
        Cells.Find(What:="*และ หักนอก", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        Selection.Offset(0, 2).Select
          If Selection.Value <> "" Then
        Range("a1").Select
        MsgBox "ข้อมูลเรียบร้อย"
        End If
        End If
        Exit Sub
    Else
    Exit Sub
    End If
errorline:
Range("a1").Select
    Exit Sub
End Sub

Code: Select all

Sub check_data()
        Dim r As Range, rCheck As Range
        Dim lRow As Long
        Dim wsAct As Worksheet
        Set wsAct = ActiveSheet
        With wsAct
            lRow = WorksheetFunction.Max(4, .Range("b" & .Rows.Count).End(xlUp).Row)
            Set rCheck = .Range("b4:b" & lRow)
        End With
        For Each r In rCheck
            If InStr(1, r.Value, "และ หักนอก") > 0 Then
                If r.Offset(0, 2) = "" Then
                    r.Offset(0, 2).Select
                    MsgBox "โปรดใส่จำนวนเงินที่จะหักในเซลล์ " & r.Offset(0,2).Address(0, 0)
                    Exit Sub
                End If
            End If
        Next r
        MsgBox "ข้อมูลสมบูรณ์แล้ว"
End Sub