Klasör İçindeki Fotografları Sayma

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
22/04/2020, 01:54

feraz

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


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
22/04/2020, 03:20

akarayilan

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
22/04/2020, 10:38

feraz

Onu daha önce yapmıştım.Hallederim zor değil.
22/04/2020, 11:01

feraz

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
23/04/2020, 02:39

akarayilan

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.
23/04/2020, 10:20

feraz

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
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15