AccessTr.neT

If .Cells(i, "H").Value + .Cells(i, "I").Value < 700 Then

   .Cells(i, "J").Value = 1

 ElseIf .Cells(i, "H").Value + .Cells(i, "I").Value >= 700 Then

   .Cells(i, "K").Value = 1

 End If

Rica ederim herzaman istekte bulunabilirsiniz.Bir deneyiniz yukardaki koddaki 700 olan yeri belki ayarlamanız gerekebilir.
Normalde diğer kod hızlı olmalıydı sanki Eklediğim kodlarda altta.J3 ve K3 e formül girmenize gerek kalmadı.

Sub ilkVeSonKlasor()



    Dim son As Long

        

    With Sheets("ANA SAYFA")

            son = .Cells(Rows.Count, 1).End(3).Row

            If WorksheetFunction.CountA(.Range("A2:A" & Rows.Count)) > 2 Then

              Me.TextBox1.Value = .Cells(4, "A").Value

              Me.TextBox2.Value = .Cells(son - 1, "A").Value

            End If

    End With



End Sub

Sub CdDvd()

    

    Dim i As Long, son As Long

    

    Application.ScreenUpdating = False

    With Sheets("ANA SAYFA")

        son = .Cells(Rows.Count, 1).End(3).Row

        

        .Range("J4:K" & Rows.Count).ClearContents

        If son < 4 Then Exit Sub

        For i = 4 To son

            If WorksheetFunction.CountA(.Range("H" & i & ":I" & i)) > 0 Then

                If .Cells(i, "H").Value + .Cells(i, "I").Value < 700 Then

                  .Cells(i, "J").Value = 1

                ElseIf .Cells(i, "H").Value + .Cells(i, "I").Value >= 700 Then

                    .Cells(i, "K").Value = 1

                End If

            End If

        Next

        

        With .Range("J3:K3")

            If son > 4 Then

                .Formula = "=sum(J4:J" & son - 1 & ")"

            Else

                .Formula = 0

            End If

                .Value = .Value

        End With

        

    End With

    Application.ScreenUpdating = True

    

End Sub

Hocam ellerine sağlık güzel olmuş zahmet veriyorum ama Rp.2020-125 Evden Hırsılık (Ahmet) gibi değilde texboxta sadece Rp.2020-125 şeklinde görebilirmiyiz teşekkürler

Onu daha önce yapmıştım.Hallederim zor değil.

ilgili kodu alttaki ile değiştirin.Mantık şöyle;textbox1 ve textbox2 ye bakar ve ilk boş karakterden öncesini alır varsa şaet bolşluk yoksa textbox boş olur.

Sub ilkVeSonKlasor()



    Dim son As Long, bul As Integer, bul2 As Integer

    Dim txt1 As MSForms.TextBox, txt2 As MSForms.TextBox

    

    Set txt1 = Me.TextBox1

    Set txt2 = Me.TextBox2

    

    With Sheets("ANA SAYFA")

        son = .Cells(Rows.Count, 1).End(3).Row

        If WorksheetFunction.CountA(.Range("A2:A" & Rows.Count)) > 2 Then

            txt1.Value = .Cells(4, "A").Value

            txt2.Value = .Cells(son - 1, "A").Value

            bul = InStr(1, txt1.Value, " ")

            bul2 = InStr(1, txt2.Value, " ")

            If bul > 0 Then txt1.Value = Mid(txt1.Value, 1, bul - 1) Else txt1.Value = Empty

            If bul2 > 0 Then txt2.Value = Mid(txt2.Value, 1, bul2 - 1) Else txt2.Value = Empty

        End If

    End With

    

    Set txt1 = Nothing

    Set txt2 = Nothing

End Sub

Hocam Ellerine sağlık teşekkürler.
gözat butonuna tıkladığımızda daha önce saydırdığımız ve ana sayfada bulunan A4 ten sonraki alanı temizlenmesi çin nasıl bir kod ekleyebiliriz. teşekkürler.

Rica ederim,alttaki kodu gözat koduna ekleiniz Dim yazan yerin altına.

Sheets("ANA SAYFA").Range("A4:K" & Rows.Count).ClearContents

Sheets("ANA SAYFA").Range("A4:K" & Rows.Count).Interior.ColorIndex = xlNone

Yada alttaki gibi.Ben üstteki gibi apıorum biçimler felan bozulmaması için.

Sheets("ANA SAYFA").Range("A4:K" & Rows.Count).Clear