udentr2002
Altın Üye
- Katılım
- 5 Kasım 2006
- Mesajlar
- 1,503
- Excel Vers. ve Dili
-
iş yerinde Office 365
evde Office 365
- Altın Üyelik Bitiş Tarihi
- 25-12-2029
Merhaba arkadaşlar;
Aşağıdaki kodu çalıştırdığımda yukarıda yazdığım hatayı verip sarı renkli satırı boyuyor
Not : Kodlar iki tarih arasında verileri süzüyor. Tarih aralığını arttıırdığımda o hatayı veriyor. Eğer tarih aralığını azalttığımda o hatayı vermiyor.
Aşağıdaki kodu çalıştırdığımda yukarıda yazdığım hatayı verip sarı renkli satırı boyuyor
Kod:
Sub Tarih_Iscilik()
Dim S1 As Worksheet, S2 As Worksheet, Satır As Integer, BUL As Range
Dim HÜCRE As Range, WF As WorksheetFunction, X As Byte, Y As Byte
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set S1 = Sheets("Maliyet_Analizi")
Set S2 = Sheets("Proje_Maliyet")
Set WF = WorksheetFunction
S1.Range("O15:P300").ClearContents
Satır = 15
S2.Rows("3:3").AutoFilter
S2.Range("A3:DM3").AutoFilter
Sheets("Proje_Maliyet").Range("A3:DM3").AutoFilter Field:=3, Criteria1:=">=" & S1.Range("r2"), _
Operator:=xlAnd _
, Criteria2:="<=" & S1.Range("r3")
If S2.Range("A65536").End(3).Row > 3 Then
For Each HÜCRE In S2.Range("A4:A" & S2.Range("A65536").End(3).Row).SpecialCells(xlCellTypeVisible)
For X = 4 To 4
If S2.Cells(HÜCRE.Row, X) <> "" Then
If WF.CountIf(S1.Range("o:o"), S2.Cells(HÜCRE.Row, X)) = 0 Then
S1.Cells(Satır, 15) = S2.Cells(HÜCRE.Row, X)
For Y = 4 To 4
If S2.Cells(HÜCRE.Row, Y) = S2.Cells(HÜCRE.Row, X) Then
S1.Cells(Satır, 16) = S1.Cells(Satır, 16) + S2.Cells(HÜCRE.Row, Y + 3)
End If
Next
Satır = Satır + 1
Else
Set BUL = S1.Range("O:O").Find(S2.Cells(HÜCRE.Row, X), LookAt:=xlWhole)
If Not BUL Is Nothing Then
For Y = 4 To 4
If S2.Cells(HÜCRE.Row, Y) = S2.Cells(HÜCRE.Row, X) Then
[color=yellow]S1.Cells(BUL.Row, 16) = S1.Cells(BUL.Row, 16) + S2.Cells(HÜCRE.Row, Y + 3)[/color]
End If
Next
End If
End If
End If
Next
Next
End If
S2.Rows("3:3").AutoFilter Field:=1
Set BUL = Nothing
Set S1 = Nothing
Set S2 = Nothing
Set WF = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub