RE: Klasör İçindeki Fotografları Sayma - feraz - 22/04/2020
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ı.
![[Resim: do.php?img=10096]](https://resim.accesstr.net/do.php?img=10096)
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
RE: Klasör İçindeki Fotografları Sayma - akarayilan - 22/04/2020
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
RE: Klasör İçindeki Fotografları Sayma - feraz - 22/04/2020
Onu daha önce yapmıştım.Hallederim zor değil.
RE: Klasör İçindeki Fotografları Sayma - feraz - 22/04/2020
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
RE: Klasör İçindeki Fotografları Sayma - akarayilan - 23/04/2020
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.
Re: Klasör İçindeki Fotografları Sayma - feraz - 23/04/2020
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
|