کمک برای تصحیح ماژول

[zizi696]

با سلام به همه دوستان عزیز
من قبلا در همین انجمن مشکلی بابت فیلتر ساعت داشتم که با کمک دوستان بوسیله دوتا ماژول حل شد بعد از مدتی متوجه شدم که در ستون A که اسم پرسنل هم نوشته شده بعد از اجرای ماژول ها به ساعت 19:00 تغییر پیدا میکنه دوستان اگه کسی میتونه کمک کنه که راهی پیدا کنم که این ماژول ها روی ساعت ها تاثیر بزاره نه روی تکست ها .
ماژول های استفاده شده

Sub rplct()
Dim lstrow As Double
Dim rr As String
Dim i As Double
lstrow = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To lstrow
If Range("A" & i) > "19:00" And Range("A" & i) <> "MandateMission6" Then
Range("A" & i) = "19:00"
End If
If Range("B" & i) <> "--" And Range("A" & i) = "--" Or Range("A" & i) = "" Then Range("A" & i).Interior.ColorIndex = 6
If Range("A" & i) <> "--" And Range("B" & i) = "--" Or Range("B" & i) = "" Then Range("B" & i).Interior.ColorIndex = 6
Next i
Application.ScreenUpdating = True
End Sub




Sub rplct()
Dim lstrow As Double
Dim rr As String
Dim i As Double
lstrow = Range("b" & Rows.Count).End(xlUp).Row
rr = ChrW(1588) & ChrW(1606) & ChrW(1576) & ChrW(1607)
For i = 1 To lstrow
If Range("c" & i) = rr And _
Range("b" & i) >= "07:00" And _
Range("b" & i) <= "08:30" Then
Range("b" & i) = "07:00"
Range("c" & i & ":b" & i).Interior.ColorIndex = 22
End If
Next i
End Sub

[M_ExceL]

با سلام به همه دوستان عزیز
من قبلا در همین انجمن مشکلی بابت فیلتر ساعت داشتم که با کمک دوستان بوسیله دوتا ماژول حل شد بعد از مدتی متوجه شدم که در ستون A که اسم پرسنل هم نوشته شده بعد از اجرای ماژول ها به ساعت 19:00 تغییر پیدا میکنه دوستان اگه کسی میتونه کمک کنه که راهی پیدا کنم که این ماژول ها روی ساعت ها تاثیر بزاره نه روی تکست ها .
ماژول های استفاده شده

Sub rplct()
Dim lstrow As Double
Dim rr As String
Dim i As Double
lstrow = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To lstrow
If Range("A" & i) > "19:00" And Range("A" & i) <> "MandateMission6" Then
Range("A" & i) = "19:00"
End If
If Range("B" & i) <> "--" And Range("A" & i) = "--" Or Range("A" & i) = "" Then Range("A" & i).Interior.ColorIndex = 6
If Range("A" & i) <> "--" And Range("B" & i) = "--" Or Range("B" & i) = "" Then Range("B" & i).Interior.ColorIndex = 6
Next i
Application.ScreenUpdating = True
End Sub

سلام،
به این صورت اصلاح کنید :

Sub rplct()
Dim lstrow As Double
Dim rr As String
Dim i As Double
lstrow = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To lstrow
nh = Replace(Range("A" & i).Text, ":", "")
If nh > 1900 And Range("A" & i).Text Like "##:##" Then
Range("A" & i) = "19:00"
Range(Cells(i, 1), Cells(i, 7)).Interior.ColorIndex = 6
End If
Next i
Application.ScreenUpdating = True
End Sub

[zizi696]

تو این ماژول ساعت های ورود یا خروجی که یکی ثبت شده و دیگری ساعت نخورده رو نشون نمیده تو ماژول ارسالی این قابلیت رو داشت و رنگ سلوی ثبت نشده مثلا زرد میشد

[M_ExceL]

تو این ماژول ساعت های ورود یا خروجی که یکی ثبت شده و دیگری ساعت نخورده رو نشون نمیده تو ماژول ارسالی این قابلیت رو داشت و رنگ سلوی ثبت نشده مثلا زرد میشد

Sub rplct()
With Application
.ScreenUpdating = False
.EnableEvents = False
    Dim lstrow As Double
    Dim rr As String
    Dim i As Double
        lstrow = Range("A" & Rows.Count).End(xlUp).Row
            For i = 2 To lstrow
                nh = Replace(Range("A" & i).Text, ":", "")
                If nh > 1900 And Range("A" & i).Text Like "##:##" Then
                    Range("A" & i) = "19:00"
                    Range(Cells(i, 1), Cells(i, 7)).Interior.ColorIndex = 6
                End If
                If Trim(Range("b" & i).Text) Like "##:##" And Not Trim(Range("a" & i).Text) Like "##:##" Then
                    Range(Cells(i, 1), Cells(i, 7)).Interior.ColorIndex = 7
                End If
                If Trim(Range("a" & i).Text) Like "##:##" And Not Trim(Range("b" & i).Text) Like "##:##" Then
                    Range(Cells(i, 1), Cells(i, 7)).Interior.ColorIndex = 7
                End If
            Next i
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub