otomatik tarih sıralama ve diğer sayfaya veri süzme

[orhancezayirli]

Merhabalar. Ekte iki adet dosya var ve her biri farklı macro'ya sahip. "OtomatikSiralama.xls" isimli dosyada tarih sütununa yeni bir tarih girdiğimde otomatik olarak tarih sırasına sokuyor ve yanındak hücreyi seçiyor (Necdet Hocam sağolsun). Daha sonra bu sıralanmış halini "SAYFALARA DAĞIT.xls" isimli dosyaya kopyalayıp yapıştırıyorum ve "sayfalara dağıt" butonuna tıklayınca USD,EURO,TL birimlere göre ayrı ayrı süzüp bu verilerle otomatik olarak yeni çalışma sayfaları oluşturuyor.
Ben bu iki dosyayı birleştirmeye çalıştım, ancak başaramadım. Yani, kopyala/yapıştır ile uğraşmadan, aynı dosyada hem otomatik sıralama yapıp, hem de butona tıklayınca süzme işlemlerine göre yeni sayfalar oluştursun istedim, beceremedim.
Yardım edebilirseniz minnettar olurum. Şimdiden teşekkürler.

 

[orhancezayirli]

yardım lütfen.

 

[Necdet]

Merhaba,

Sıralama makrosunu düzenledim. Aynı tarih girilse bile ilgili boş satır seçiliyor. Sayfalara dağıtan kodlarınıza hiç dokunmadım olduğu gibi dosyadan aldım.

Kodları buraya da ekleyelim.

Aşağıdaki kodlar "VERİ" sayfasının kod bölümünde olmalı.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    On Error GoTo Son
    Dim Sat As Long
    Dim Kolon As Integer
    Dim Deger As Variant
    Dim c As Range
 
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target.Row < 2 Then Exit Sub
 
    Application.ScreenUpdating = False
 
    Kolon = 7
    Deger = Target.Value
    Cells(Target.Row, Kolon) = 1
    Sat = Cells(Rows.Count, "A").End(3).Row
    Range(Cells(2, "A"), Cells(Sat, Kolon)).Sort Key1:=Cells(2, "A")
    Set c = Range(Cells(1, Kolon), Cells(Sat, Kolon)).Find(1, LookIn:=xlValues)
    Cells(c.Row, Kolon) = ""
    Range("B" & c.Row).Select
 
Son:
 
End Sub

Aşağıdaki kodlar ise bir Modülde olmalı.

Sub DAGIT()
Dim s1 As Worksheet
Dim sY As Worksheet
Dim ALAN As Range
Dim r As Integer
Dim c As Range
Set s1 = Sheets("VERİ")
Set ALAN = Range("Veritabani")
 
s1.Columns("b:b").Copy _
  Destination:=Range("L1")
s1.Columns("L:L").AdvancedFilter _
  Action:=xlFilterCopy, _
  CopyToRange:=Range("J1"), Unique:=True
r = Cells(Rows.Count, "J").End(xlUp).Row
 
Range("L1").Value = Range("b1").Value
For Each c In Range("J2:J" & r)
 
  s1.Range("L2").Value = c.Value
 
  If SAYFA(c.Value) Then
    Sheets(c.Value).Cells.Clear
    ALAN.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("VERİ").Range("L1:L2"), _
        CopyToRange:=Sheets(c.Value).Range("A1"), _
        Unique:=False
  Else
    Set sY = Sheets.Add
    sY.Move After:=Worksheets(Worksheets.Count)
    sY.Name = c.Text
    ALAN.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("VERİ").Range("L1:L2"), _
        CopyToRange:=sY.Range("A1"), _
        Unique:=False
  End If
Next
s1.Select
s1.Columns("J:L").Delete
End Sub

Function SAYFA(SAYFAADI As String) As Boolean
    On Error Resume Next
    SAYFA = CBool(Len(Worksheets(SAYFAADI).Name) > 0)
End Function

 

[orhancezayirli]

Necdet hocam, teşekkür ederim. Aynı şeyi ben de düşünmüştüm. Sayfalara dağıt modülünün olduğu dosyayı aynen bırakıp, Veri sayfasına Otomatik sıralama kodlarını kopyalayıp çalışmasını bekledim, ancak her sefernde 1004 hatası alıyordum. Debug yaptığımda da her seferinde "Veritabani" yazısının geçtiği satır hata veriyordu. Cevabınız bana en azından doğru yönde düşündüğümü gösterdi. Ancak sizin eklediğiniz dosyada da aynı hatayı aldım. Daha sonra ilginç birşey oldu. İki dosyayı yanyana açtım. Kodları incelemek için Worksheet altında Activate, Chance, vs. hepsini teker teker açtım, karşılaştırdım. Bir fark görünmüyordu. Son olarak Otomatik sıralama.xls deki kodları Change bölümüne tekrar yapıştırdım ve Bingo!..Bu sefer çalıştı. Tekrar detaylı incelediğimde hatayı buldum. Set ALAN = Range("Veritabani") satırında Set ALAN = Range("VERİTABANI") şeklinde farklılık vardı. Programcıların klasik kabusu Sitede aynı dosyaya ihtiyaç duyabilecek kişiler için düzeltilmiş dosyayı ekliyorum.
Yardımlarınız için çok teşekkür ederim. Bir kez daha sıkıntımı çözdünüz. İyi çalışmalar dilerim.

 

[Necdet]

Evet unuttum veritabanı yazılımını size hatırlatmayı.

Güle güle kullanınız.

 

[orhancezayirli]

Necdet Bey, tekrar yardımınıza ihtiyacım var. Örnek dosya üzerinde makrolar sorunsuz çalışıyor. Ancak gerçek dosyamdaki verileri örnek dosyaya kopyaladığım zaman sorun çıktı. Dosyadaki veriler 2000 satır kadar tutuyor. Otomatik sıralama makrosu sorunsuz çalışıyor, ancak Sayfalara Dağıt makrosu, ilk 100 satır için işlem yapıyor, sonraki satırları almıyor. Sorunun kaynağını bulamadım. İnceleyip yardımcı olabilirseniz minnettar kalırım.
Teşekkürler.

 

[Necdet]

Merhaba,

Sizinde bildiğiniz gibi "Veritabani" adlı bir AD tanımı var dosyanızda. Ad tanımı A1:F100 olarak sabit tanımlı yapılmış. Siz bu tanımı aşağıda vereceğim gibi değiştiriniz. Değişken AD tanımı olacak.

=KAYDIR(VERİ!$A$1;;;BAĞ_DEĞ_DOLU_SAY(VERİ!$A:$A);6)

 

[orhancezayirli]

Maalesef AD tanımını nasıl değiştireceğimi bilmiyorum Nerede bulabilirim diye çok araştırdım, ancak bulamadım. Son olarak o konuda da yardımcı olabilirseniz sıkıntm kalmayacak. Teşekkürler.

 

[Necdet]

Merhaba,

2003 kullanıyorsunuz, bende de 2003 yok o yüzden tarif edemeyeceğim.
Ama forumda "ALAN ADI" olarak aratırsanız excel dersane bölümünde bulabilirsiniz.

Her ihtimale göre ben kodda yapılacak değişikliği buraya yazayım, o zaman AD tanımını kullanmamış oluruz.

Kodun içinde

Set ALAN = Range("Veritabani")

geçen satırı aşağıdaki şekilde değiştiriniz.

Set ALAN = s1.Range("A1:F" & s1.Cells(Rows.Count, "A").End(3).Row)

sorununuz çözülecektir.

 

[orhancezayirli]

Necdet Hocam, bir kez daha sorunumu çözdünüz. Allah razı olsun.
Excel konusunda öğrenileceklerin sonu yok. Yardımlarınız için tekrar teşekkür ederim.

 

[Necdet]

Necdet Hocam, bir kez daha sorunumu çözdünüz. Allah razı olsun.
Excel konusunda öğrenileceklerin sonu yok. Yardımlarınız için tekrar teşekkür ederim.

Güle güle kullanınız.