Veritabanı sınırı

Katılım
31 Ocak 2006
Mesajlar
3
merhabalar.
excel de bir listeyi sayfalara ayırmak için aşağıdaki makro tanımlı.
ancak satır sayısı 100 ile sınırlı. yani 100 üncü satırdan sonrası için makro çalışmıyor ve sayfa oluşturmuyor.
nasıl tüm listeyi aktif hale getirebilirim?
saygılar

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("VERİTABANI")


s1.Columns("d:d").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("d1").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.Value
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
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
Satır sayısı 100 ile sınırlı değil.
J kolonunda dolu olan son hücreye kadar işlem yapıyor.
Demekki J kolonunda en son dolu olan hücre J100 hücresi.

Eğer başka bir kolonu baz almak isterseniz aşağıdaki satırı değiştiriniz.

Kod:
r = Cells(Rows.Count, "J").End(xlUp).Row
A sütununu baz almak isterseniz

Kod:
r = Cells(Rows.Count, "A").End(xlUp).Row
yapmalısınız.

eğer satır sayısı sabit kalsın isterseniz ki bunu önermem aşağıdaki gibi 200 satır yapabilirsiniz.

Kod:
r = 200
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
Filitreleme sabit bir alan adına başvuruyor.
Sorun bundan kaynaklanıyor.

Düzeltmek için
Kod:
Set ALAN = Range("VERİTABANI")
satırı yerine aşağıdakini kopyalayın.
Kod:
Set ALAN = Range("A1:E" & Cells(Rows.Count, "A").End(3).Row)
Yeni kodlar şöyle olmalı

Kod:
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("A1:E" & Cells(Rows.Count, "A").End(3).Row)
    
    s1.Columns("d:d").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("d1").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.Value
        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
 
Katılım
31 Ocak 2006
Mesajlar
3
çok teşekkürler hocam işe yaradı.
formüller sekmesindeki ad yöneticisinden de düzenlenebiliyormuş.
saygılar
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
çok teşekkürler hocam işe yaradı.
formüller sekmesindeki ad yöneticisinden de düzenlenebiliyormuş.
saygılar
Evet ama alandaki satır sayısı her değiştiğinde ad alanını değiştimenize gerek yok.
Yukarıdaki kod her zaman son dolu satıra kadar işlem yapıyor.
Satır eklense yada silinse asla sorun çıkmıyor ve başka bir işlem yapmanıza da gerek kalmıyor.
 
Üst