Süz işlemini formul ile yaptırmak

[doukan84]

MErhaba arkadaşlar gene sizlerden yardım talebinde bulunuyorum forum sayesinde çok şey öğrendim. Yardım eden arkadaşlarıma şimdiden çok teşekkür ediyorum...


Benim şöyle bir sıkıntım var bizde hergün üst birimlerimizden 2000-3000 sayfalık bir veri geliyor ve biz hergün bu verileri süzüp kendi birimimizle ilgili olan sayfalara aktarıyoruz ve aktarırkende belli başlı sütunları siliyoruz. Daha sonrada bunların çıktılarını alıyoruz.. okadar yoğun işin arasında bir tam akşam mesai bitiminde bu işle uğraşmak bizi çok yoruyor.. Ekte bir dosya var burdada yapmak istediğimi yazdım... Düşeyara formulü denedim indis formulü denedim ama yapamadım.. bir bakarsanız çok sevinirim

 

[hamitcan]

Kodları düğmelere bağlarsınız...

Sub birim_1181_1182()
Sheets("1181-1182 birimi").Cells.Clear
    Sheets("veri").Range("$A$1:$F$28").AutoFilter Field:=2, Criteria1:="=1181", _
        Operator:=xlOr, Criteria2:="=1182"
         Sheets("veri").Range("a1:f" & Sheets("veri").[a65536].End(3).Row).Copy _
         Sheets("1181-1182 birimi").[a1]
     Sheets("1181-1182 birimi").Columns(3).Clear
End Sub
Sub birim_1183_1184()
Sheets("1183-1184 birimi").Cells.Clear
    Sheets("veri").Range("$A$1:$F$28").AutoFilter Field:=2, Criteria1:="=1183", _
        Operator:=xlOr, Criteria2:="=1184"
         Sheets("veri").Range("a1:f" & Sheets("veri").[a65536].End(3).Row).Copy _
         Sheets("1183-1184 birimi").[a1]
      Sheets("1183-1184 birimi").Columns(3).Clear
End Sub
Sub birim_1185_1186()
Sheets("1185-1186 birimi").Cells.Clear
    Sheets("veri").Range("$A$1:$F$28").AutoFilter Field:=2, Criteria1:="=1185", _
        Operator:=xlOr, Criteria2:="=1186"
         Sheets("veri").Range("a1:f" & Sheets("veri").[a65536].End(3).Row).Copy _
         Sheets("1185-1186 birimi").[a1]
     Sheets("1185-1186 birimi").Columns(3).Clear
End Sub

 

[sametozyavuz]

MErhaba arkadaşlar gene sizlerden yardım talebinde bulunuyorum forum sayesinde çok şey öğrendim. Yardım eden arkadaşlarıma şimdiden çok teşekkür ediyorum...


Benim şöyle bir sıkıntım var bizde hergün üst birimlerimizden 2000-3000 sayfalık bir veri geliyor ve biz hergün bu verileri süzüp kendi birimimizle ilgili olan sayfalara aktarıyoruz ve aktarırkende belli başlı sütunları siliyoruz. Daha sonrada bunların çıktılarını alıyoruz.. okadar yoğun işin arasında bir tam akşam mesai bitiminde bu işle uğraşmak bizi çok yoruyor.. Ekte bir dosya var burdada yapmak istediğimi yazdım... Düşeyara formulü denedim indis formulü denedim ama yapamadım.. bir bakarsanız çok sevinirim

düzeltilmiş yeni versiyon.
sanırım aradığınız şey bu bir kontrol edin.
ayrıca üç butonu da teke indirdim.
kolay gelsin.
sorun varsa mj atın.

 

[sametozyavuz]

Kodları düğmelere bağlarsınız...

Sub birim_1181_1182()
Sheets("1181-1182 birimi").Cells.Clear
    Sheets("veri").Range("$A$1:$F$28").AutoFilter Field:=2, Criteria1:="=1181", _
        Operator:=xlOr, Criteria2:="=1182"
         Sheets("veri").Range("a1:f" & Sheets("veri").[a65536].End(3).Row).Copy _
         Sheets("1181-1182 birimi").[a1]
     Sheets("1181-1182 birimi").Columns(3).Clear
End Sub
Sub birim_1183_1184()
Sheets("1183-1184 birimi").Cells.Clear
    Sheets("veri").Range("$A$1:$F$28").AutoFilter Field:=2, Criteria1:="=1183", _
        Operator:=xlOr, Criteria2:="=1184"
         Sheets("veri").Range("a1:f" & Sheets("veri").[a65536].End(3).Row).Copy _
         Sheets("1183-1184 birimi").[a1]
      Sheets("1183-1184 birimi").Columns(3).Clear
End Sub
Sub birim_1185_1186()
Sheets("1185-1186 birimi").Cells.Clear
    Sheets("veri").Range("$A$1:$F$28").AutoFilter Field:=2, Criteria1:="=1185", _
        Operator:=xlOr, Criteria2:="=1186"
         Sheets("veri").Range("a1:f" & Sheets("veri").[a65536].End(3).Row).Copy _
         Sheets("1185-1186 birimi").[a1]
     Sheets("1185-1186 birimi").Columns(3).Clear
End Sub

hamit bey siz cevap yazmadan önce ben de kendimce cevap yazmaya çalıştım. ama öne siz yazmışsınız bile.
oluşturduğum dosya yukarıda var. bir deneyip kotrol edermisiniz. ben VBA da çok yeniyim ve öğrenmek istiyorum. yorumlarınızı bekliyorum.

 

[hamitcan]

Mantığınız doğru sadece kodu biraz uzun yazmışsınız ama önemli değil zamanla kodu kısaltmayı da öğrenirsiniz. Size tavsiyem forumdaki kodları inceleyin ve bol bol soru çözün.

 

[Necdet]

Merhaba,

Alternatif olsun.

Aktarılacak sayfaları kendisi oluşturur.
Satır sayısına bağlı değildir.

Birim kodları hep bir ardışık sayı olarak gidiyorsa kodları daha da kısaltmak olası.

Değişik birimlerin de listelenmesi istenirse

    BsBir = Array(1181, 1183, 1185)
    BtBir = Array(1182, 1184, 1186)

aynı mantık ile diziye ekleme yapılmalıdır. Bu eklemede dikkat edilecek olay alfanümerik değerler olursa onları Çift Tırnak içinde yazmalı.

Sub SuzVeAktar()
    
    Dim i   As Long, _
        j   As Integer, _
        BsBir, _
        BtBir, _
        Syf As Worksheet, _
        ShV As Worksheet, _
        ShName As String
    
    Set ShV = Sheets("Veri")
    
    BsBir = Array(1181, 1183, 1185)
    BtBir = Array(1182, 1184, 1186)
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    For Each Syf In Worksheets
        If Not Syf.Name = ShV.Name Then Syf.Delete
    Next Syf
    
    If ActiveSheet.AutoFilterMode = True Then Cells.AutoFilter
    
    i = Cells(Rows.Count, "A").End(3).Row
    
    For j = 0 To UBound(BsBir)
    
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = BsBir(j) & "-" & BtBir(j)
        ShName = ActiveSheet.Name
        ShV.Select
        ActiveSheet.Range("$A$1:$F$" & i).AutoFilter Field:=2, Criteria1:=">=" & BsBir(j), _
            Operator:=xlAnd, Criteria2:="<=" & BtBir(j)
        Range("A1").CurrentRegion.Copy Sheets(ShName).Range("A1")
        Sheets(ShName).Columns(3).Delete
        
    Next j
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    MsgBox "Süzdüm ve Aktardım...", vbInformation, "excel.web.tr, N. YEŞERTENER"
    
End Sub

 

[doukan84]

Çok Teşekkür ederim tam aradığım şey buydu..İftar vakti sevap işlediniz Allah Razı olsun... Birde bu işlemlerin sonunda yazdır desek hepsini çıktı alsa o sayfaların o mümkünmü acaba?