Filitre

[vivident]

Merhaba

Ekte dökümanda 1 den 100'e kadar ardışık isimli sayfalarım var. Bu sayfaları filitrelemek istiyorum. Dosyamda iki adet filitreleme yöntemi var. Esasında ikisi de çalışıyor.

1 nolu kod filitreleme işlemini sayfa adına göre
2 nolu kod ise 1'den 100' e kadar olan sayfa sırasına göre filitreliyor.

1 nolu kod için 1,100 kadar olan sayfaları "IF OR ELSE" ile tek tek yazdım. Daha basit yönetimi yokmudur ? veya olması gereken bu mudur ? Diğer kodu kullanayım diyorum o da sayfa sırasına göre kullandığı için filitreleme yapılmayacak sayfaları da filitreliyor (Örn:AAA,BBB,CCC)

 

[Erdem Akdemir]

Merhaba,

For i = 1 To Worksheets.Count
If Worksheets(i).Name = "1"

yerine

For i = 1 To Worksheets.Count
If Worksheets(i).Name = i

diyebilirsiniz.

 

[vivident]

Kodu bu şekilde değiştirdim, ama çalışmadı malesef

Sub AAAfiltre()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next
Call AraII_Reset
Set s1 = ThisWorkbook.Worksheets("ANA SAYFA")
For i = 1 To Worksheets.Count
If Worksheets(i).Name = i Then
Set s2 = ThisWorkbook.Worksheets(i)
    s2.Select
    If s1.Cells(4, 3) <> "" Then Selection.AutoFilter Field:=1, Criteria1:=s1.Cells(4, 3)
    If s1.Cells(4, 3) = "" Then Selection.AutoFilter Field:=1
    If s1.Cells(4, 5) <> "" Then Selection.AutoFilter Field:=2, Criteria1:=s1.Cells(4, 5)
    If s1.Cells(4, 5) = "" Then Selection.AutoFilter Field:=2
    If s1.Cells(4, 7) <> "" Then Selection.AutoFilter Field:=3, Criteria1:=s1.Cells(4, 7)
    If s1.Cells(4, 7) = "" Then Selection.AutoFilter Field:=3
    If s1.Cells(4, 9) <> "" Then Selection.AutoFilter Field:=4, Criteria1:=s1.Cells(4, 9)
    If s1.Cells(4, 9) = "" Then Selection.AutoFilter Field:=4
    End If
    Range("B4").Select
    Next i
    Sheets("ANA SAYFA").Select
    MsgBox "seçilen kritere göre filitreleme işlemi yapılmıştır" & vbLf & _
    "verilerin hesaplanması için lütfen bekleyiniz", vbOKOnly + vbInformation, Application.UserName
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[Erdem Akdemir]

Aşağıdaki gibi deneyin.

Sub İsmegörefiltre()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next
Call Ara_Reset
Set s1 = ThisWorkbook.Worksheets("ANA SAYFA")
For Each i In Worksheets
If IsNumeric(i.Name) Then
Set s2 = i
    s2.Select
    If s1.Cells(4, 3) <> "" Then Selection.AutoFilter Field:=1, Criteria1:=s1.Cells(4, 3)
    If s1.Cells(4, 3) = "" Then Selection.AutoFilter Field:=1
    If s1.Cells(4, 5) <> "" Then Selection.AutoFilter Field:=2, Criteria1:=s1.Cells(4, 5)
    If s1.Cells(4, 5) = "" Then Selection.AutoFilter Field:=2
    If s1.Cells(4, 7) <> "" Then Selection.AutoFilter Field:=3, Criteria1:=s1.Cells(4, 7)
    If s1.Cells(4, 7) = "" Then Selection.AutoFilter Field:=3
    If s1.Cells(4, 9) <> "" Then Selection.AutoFilter Field:=4, Criteria1:=s1.Cells(4, 9)
    If s1.Cells(4, 9) = "" Then Selection.AutoFilter Field:=4
    End If
    Next
    Sheets("ANA SAYFA").Select
    MsgBox "tüm kriterler devre dışı brakılmıştır" & vbLf & _
    "verilerin hesaplanması için lütfen bekleyiniz", vbOKOnly + vbInformation, Application.UserName
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[vivident]

Sayın kuvari çok teşekkürler, büyük zahmetten kurtardınız