RANDEVU LİSTESİNDE GİRİLEN SAAT İLE VERİLERİ OTOMATİK SIRALAMA

[YUSUF44]

Aşağıdaki kodu kullanın:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If ActiveSheet.Name = "PAZARTESİ" Or ActiveSheet.Name = "SALI" Or ActiveSheet.Name = "ÇARŞAMBA" Or _
        ActiveSheet.Name = "PERŞEMBE" Or ActiveSheet.Name = "CUMA" Or ActiveSheet.Name = "CUMARTESİ" Then
        If Intersect(Target, Range("D3:D14")) Is Nothing Then Exit Sub
        If Selection.Count > 1 Then Exit Sub
        If Target = "" Then
            Target.Offset(0, 3) = "X"
            GoTo 10
        Else
            If IsNumeric(Target) Then
                If Target < 1 Then
                    Target.Offset(0, 3) = "X"
                    GoTo 10
                End If
                Application.EnableEvents = False
                    Target.Offset(0, 3) = "X"
                    Target = Evaluate("=IF(" & Target & ">2400,""Hatalı saat"",IF(" & Target & "<=24,TIME(" & Target _
                        & ",0,0),IF(" & Target & "<100,""Hatalı saat"",IF(MOD(" & Target & ",100)>59,""Hatalı dakika"",TIME((" _
                        & Target & "-(MOD(" & Target & ",100)))/100,MOD(" & Target & ",100),0)))))")
                Application.EnableEvents = True
            Else
                Exit Sub
            End If
        End If
10:
        ActiveSheet.Sort.SortFields.Clear
        ActiveSheet.Sort.SortFields.Add Key:=Range( _
            "D3:D14"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveSheet.Sort
            .SetRange Range("B2:G14")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        yer = WorksheetFunction.Match("X", [G1:G14], 0)
        Cells(yer, "E").Select
        Cells(yer, "G") = ""
    End If
End Sub

Ayrıca excelde hücredeki veriyi dilmek için Backspace kullanmayın, Delete kullanın. Backspace kullandığınızda imleç hücrenin içine girer, hücreye bir şey yazmayacaksanız hücreden çıkmak için başka bir işlem yapmanız gerekir. Bir de muhtemelen biliyorsunuzdur, hücredeki veriyi "tamamen" değiştirmek için hücre içindeki veriyi silmenize gerek yok, yeni verinizi doğrudan hücreye yazabilirsiniz.

 

[anorian]

Aşağıdaki kodu kullanın:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If ActiveSheet.Name = "PAZARTESİ" Or ActiveSheet.Name = "SALI" Or ActiveSheet.Name = "ÇARŞAMBA" Or _
        ActiveSheet.Name = "PERŞEMBE" Or ActiveSheet.Name = "CUMA" Or ActiveSheet.Name = "CUMARTESİ" Then
        If Intersect(Target, Range("D3:D14")) Is Nothing Then Exit Sub
        If Selection.Count > 1 Then Exit Sub
        If Target = "" Then
            Target.Offset(0, 3) = "X"
            GoTo 10
        Else
            If IsNumeric(Target) Then
                If Target < 1 Then
                    Target.Offset(0, 3) = "X"
                    GoTo 10
                End If
                Application.EnableEvents = False
                    Target.Offset(0, 3) = "X"
                    Target = Evaluate("=IF(" & Target & ">2400,""Hatalı saat"",IF(" & Target & "<=24,TIME(" & Target _
                        & ",0,0),IF(" & Target & "<100,""Hatalı saat"",IF(MOD(" & Target & ",100)>59,""Hatalı dakika"",TIME((" _
                        & Target & "-(MOD(" & Target & ",100)))/100,MOD(" & Target & ",100),0)))))")
                Application.EnableEvents = True
            Else
                Exit Sub
            End If
        End If
10:
        ActiveSheet.Sort.SortFields.Clear
        ActiveSheet.Sort.SortFields.Add Key:=Range( _
            "D3:D14"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveSheet.Sort
            .SetRange Range("B2:G14")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        yer = WorksheetFunction.Match("X", [G1:G14], 0)
        Cells(yer, "E").Select
        Cells(yer, "G") = ""
    End If
End Sub

Ayrıca excelde hücredeki veriyi dilmek için Backspace kullanmayın, Delete kullanın. Backspace kullandığınızda imleç hücrenin içine girer, hücreye bir şey yazmayacaksanız hücreden çıkmak için başka bir işlem yapmanız gerekir. Bir de muhtemelen biliyorsunuzdur, hücredeki veriyi "tamamen" değiştirmek için hücre içindeki veriyi silmenize gerek yok, yeni verinizi doğrudan hücreye yazabilirsiniz.

teşekkürler çözüldü böyle deneyelim sorun çıkarsa tekrar sizi rahatsız ederiz saolun