rapor alma

[zehfeysal]

hayırlı akşamlar
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("ı3")) Is Nothing Then Exit Sub
CommandButton1_Click
End Sub
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim s4 As Worksheet
Set s4 = Sheets("GİDER")
Range("G115000").ClearContents
BasT = Range("I5")
BitT = Range("I7")
sat = 12
For i = 2 To s4.[c65536].End(3).Row
If Range("ı3") = s4.Cells(i, "c") And BasT <= s4.Cells(i, 2) And BitT >= s4.Cells(i, 2) Then
Cells(sat, "g") = sat - 11
Cells(sat, "i") = s4.Cells(i, "c")
Cells(sat, "k") = s4.Cells(i, "e")
Cells(sat, "m") = s4.Cells(i, "b")
Cells(sat, "n") = s4.Cells(i, "d")

sat = sat + 1
End If
Next i
Range("ı3").Select
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


yukarıdaki kodla veriyi gider türüne ve tarih aralığına göre raporlamayı sitededik arkadasların sayesinde basardık tarih aralığına göre giderin hepsini de raporlaya bilirmiyiz

ı3 bos ise

If Range("ı3") <> s4.Cells(i, "c") And BasT <= s4.Cells(i, 2) And BitT >= s4.Cells(i, 2) Then
ı3 dolu ise

If Range("ı3") = s4.Cells(i, "c") And BasT <= s4.Cells(i, 2) And BitT >= s4.Cells(i, 2) Then
ayarlıya bilirmiyiz

 

[askm]

Aşağıdaki şekilde revize edin.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("ı3")) Is Nothing Then Exit Sub
CommandButton1_Click
End Sub
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim s4 As Worksheet
Set s4 = Sheets("GİDER")
Range("G11:o5000").ClearContents
BasT = Range("I5")
BitT = Range("I7")
sat = 12
If Range("I3") <> "" Then
For i = 2 To s4.[c65536].End(3).Row
If Range("ı3") = s4.Cells(i, "c") And BasT <= s4.Cells(i, 2) And BitT >= s4.Cells(i, 2) Then
Cells(sat, "g") = sat - 11
Cells(sat, "i") = s4.Cells(i, "c")
Cells(sat, "k") = s4.Cells(i, "e")
Cells(sat, "m") = s4.Cells(i, "b")
Cells(sat, "n") = s4.Cells(i, "d")

  sat = sat + 1
End If
Next i
Else
For i = 2 To s4.[c65536].End(3).Row
If BasT <= s4.Cells(i, 2) And BitT >= s4.Cells(i, 2) Then
Cells(sat, "g") = sat - 11
Cells(sat, "i") = s4.Cells(i, "c")
Cells(sat, "k") = s4.Cells(i, "e")
Cells(sat, "m") = s4.Cells(i, "b")
Cells(sat, "n") = s4.Cells(i, "d")

  sat = sat + 1
End If
Next i
End If
Range("ı3").Select
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[zehfeysal]

hocam istediğim gibi oldu Allah razı olsun

 

[askm]

Rica ederim. Hayırlı akşamlar.