• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Çok Hızlı Satır Silebilmek

  • Konbuyu başlatan Konbuyu başlatan mekist
  • Başlangıç tarihi Başlangıç tarihi
M

mekist

Altın Üye
Katılım
13 Ağustos 2008
Mesajlar
355
Excel Vers. ve Dili
Office 365 ProPlus-Türkçe
Merhaba,
Aşağıdaki makro ile K sütununda düşeyara sonucu ile getirilen x olan satırları silebiliyorum. Fakat Satır sayısı 5 bin olunca satırları çok yavaş siliyor.
Excelin kendi satır sil özelliği gibi çok hızlı birşekilde sildirebilmek için ne yapabilirim. Yardımcı olabilir misiniz.

Sub Sil()
Dim i As Long
For i = [K65536].End(3).Row To 1 Step -1
If Cells(i, "K") = "x" Then Rows(i).Delete
Next i
End Sub
 
merhaba.
veri
filtre
sadece x işaretli
başlık hariç tüm satırlar satır no'dan seçili
sağ tık
sil
tamam
 
eyvallah da oradan yapıldığını biliyorum.
Makro ile yapmam gerektiği için
 
gerek sitemizde gerekse internet aramasında onlarca örnek bulabilirsiniz.


Kod: 
Option Explicit

Sub satirsil()

Dim rng As Range
Dim krit As String
Dim sut As Long
Dim xlCalc As XlCalculation

    On Error Resume Next
    Application.Goto Range("K1")
    Set rng = ActiveCell.CurrentRegion
    sut = 11 'K sütununun numarası
    krit = "x"
    
    With Application
        xlCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
       
    ActiveSheet.AutoFilterMode = False
    
    With rng
      .AutoFilter Field:=11, Criteria1:=krit
      .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    ActiveSheet.AutoFilterMode = False
    
    With Application
        .Calculation = xlCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub
 
Gönderdiğiniz "K1" den başlayarak kriter ayırmadan herşeyi siliyor. Ayrıca tek tek siliyor. Sitede bulamadığım için yazdım. Bulsam yazmazdım sanırım
 
Selamlar,

Alternatif olarak aşağıdaki kodu denermisiniz.

Kodu test ettiğimde aşağıdaki sonuçları elde ettim.

65536 satırlık veride silme işlemini yaklaşık 5 dakikada tamamladı.
10000 satırlık veride silme işlemini yaklaşık 1 dakikada tamamladı.

Not : Daha önce başka bir başlıkta SpecialCells komutu ile ile ilgili bir gözlemimi ifade etmiştim. Bu komut gözlemlerime göre Integer veri değişkenini destekliyor. Bu sebeple süzülen alandaki veri sayısı bu sınırı aşarsa silme işlemini gerçekleştirmiyor. Yani bu komutu dikkatli kullanmak gerekiyor. Bende aşağıdaki kodda bu komutu kullandım. Fakat süzülmüş alandaki satırları 3855 satırlık parçalara bölerek kullanarak sorununu aşmaya çalıştım.


Kod: 
Option Explicit
 
Sub KOŞULLU_SATIR_SİL()
    Dim İLK As Date, SON As Date, X As Long
 
    İLK = Time
 
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
 
    If ActiveSheet.AutoFilterMode Then Range("A1").AutoFilter
    Range("A1").AutoFilter Field:=11, Criteria1:="X"
 
    For X = 65536 To 2 Step -3855
        On Error Resume Next
        Range(Cells(X - 3854, 1), Cells(X, 1)).SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
        On Error GoTo 0
    Next
 
    Range("A1").AutoFilter Field:=11
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
 
    SON = Time
 
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
    "İşlem süresi ; " & Format((SON - İLK), "hh:mm:ss")
End Sub
 
mekist' Alıntı:
Gönderdiğiniz "K1" den başlayarak kriter ayırmadan herşeyi siliyor. Ayrıca tek tek siliyor. Sitede bulamadığım için yazdım. Bulsam yazmazdım sanırım
Genişletmek için tıkla ...

kod buraya yazılmadan önce denenmiş, herhangi bir sorun yaşanmaması, arzu edilen sonuca çok kısa bir sürede ulaşılması üzerine buraya aktarılmıştır.

not: eleştiri değil, doğru yöntem konusunda öneri amaçlı bir cümle için, kendisine yardımcı olmaya çalışan birine laf sokma gayreti ise hiç şık değil.
 
Korhan Ayhan' Alıntı:
Selamlar,

Alternatif olarak aşağıdaki kodu denermisiniz.

Kodu test ettiğimde aşağıdaki sonuçları elde ettim.

65536 satırlık veride silme işlemini yaklaşık 5 dakikada tamamladı.
10000 satırlık veride silme işlemini yaklaşık 1 dakikada tamamladı.

Not : Daha önce başka bir başlıkta SpecialCells komutu ile ile ilgili bir gözlemimi ifade etmiştim. Bu komut gözlemlerime göre Integer veri değişkenini destekliyor. Bu sebeple süzülen alandaki veri sayısı bu sınırı aşarsa silme işlemini gerçekleştirmiyor. Yani bu komutu dikkatli kullanmak gerekiyor. Bende aşağıdaki kodda bu komutu kullandım. Fakat süzülmüş alandaki satırları 3855 satırlık parçalara bölerek kullanarak sorununu aşmaya çalıştım.


Kod: 
Option Explicit
 
Sub KOŞULLU_SATIR_SİL()
    Dim İLK As Date, SON As Date, X As Long
 
    İLK = Time
 
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
 
    If ActiveSheet.AutoFilterMode Then Range("A1").AutoFilter
    Range("A1").AutoFilter Field:=11, Criteria1:="X"
 
    For X = 65536 To 2 Step -3855
        On Error Resume Next
        Range(Cells(X - 3854, 1), Cells(X, 1)).SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
        On Error GoTo 0
    Next
 
    Range("A1").AutoFilter Field:=11
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
 
    SON = Time
 
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
    "İşlem süresi ; " & Format((SON - İLK), "hh:mm:ss")
End Sub
Genişletmek için tıkla ...

Korhan Bey,
Makroyu çalıştırdığımda "400" diye hata veiyor.
Yanlış anlamadım ise filtre yapılmış bir alanda silme işlemi yapıyor. Filtre yapılmasına gerek olmaksızın. Örneğin "K" sütununda yer alan "x" olan satırları silmek istiyorum. Tekrar bakma şansınız varmıdır?
 
Selamlar,

Filtre uygulamadan yapmak isterseniz sizin ilk mesajınızda yazan kodu kullanmanız gerekir. Fakat bu yöntemde çok satırlı datalarda yavaşlamaya sebep olacaktır. Bu sebeple filtre yöntemini kullanarak çözüm sunmuştum.

Hata aldığınız dosyayı eklemeniz mümkünse hatanın sebebini kontrol edebiliriz.
 
Sayın mekist

Kullanmış olduğunuz kodlar silme işlemini 14.000 satırda 55 saniye de işlem yapıyor. Ancak atladığınız şey, işlemi uzun sürdüren ekran yenilemesi ve formül hesaplaması. Kodları şöyle kullanırsanız aynı veriyi çok kısa sürede (14.000 satırda ~2 saniyede) silersiniz.


Kod: 
Sub Sil()
Dim i As Long
'İLK = Time
[COLOR=blue]With Application[/COLOR]
[COLOR=blue]   .ScreenUpdating = False[/COLOR]
[COLOR=blue]   .Calculation = xlCalculationManual[/COLOR]
[COLOR=blue]   .EnableEvents = False[/COLOR]
[COLOR=blue]End With[/COLOR]
For i = [K65536].End(3).Row To 1 Step -1
If Cells(i, "K") = "x" Then Rows(i).Delete
Next i
[COLOR=blue]With Application[/COLOR]
[COLOR=blue]   .ScreenUpdating = True[/COLOR]
[COLOR=blue]   .Calculation = xlCalculationAutomatic[/COLOR]
[COLOR=blue]   .EnableEvents = True[/COLOR]
[COLOR=blue]End With[/COLOR]
'SON = Time
   ' MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
    "İşlem süresi ; " & Format((SON - İLK), "hh:mm:ss")
End Sub
 
Selamlar,
Filtreyi makro kendimi yapacak, manuel mi yapılacak.

Benim dosyam çok karmaşık, sizin deneme yaptığınız dosyayı yüklemeniz mümkün müdür?
 
AS3434' Alıntı:
Sayın mekist

Kullanmış olduğunuz kodlar silme işlemini 14.000 satırda 55 saniye de işlem yapıyor. Ancak atladığınız şey, işlemi uzun sürdüren ekran yenilemesi ve formül hesaplaması. Kodları şöyle kullanırsanız aynı veriyi çok kısa sürede (14.000 satırda ~2 saniyede) silersiniz.


Kod: 
Sub Sil()
Dim i As Long
'İLK = Time
[COLOR=blue]With Application[/COLOR]
[COLOR=blue]   .ScreenUpdating = False[/COLOR]
[COLOR=blue]   .Calculation = xlCalculationManual[/COLOR]
[COLOR=blue]   .EnableEvents = False[/COLOR]
[COLOR=blue]End With[/COLOR]
For i = [K65536].End(3).Row To 1 Step -1
If Cells(i, "K") = "x" Then Rows(i).Delete
Next i
[COLOR=blue]With Application[/COLOR]
[COLOR=blue]   .ScreenUpdating = True[/COLOR]
[COLOR=blue]   .Calculation = xlCalculationAutomatic[/COLOR]
[COLOR=blue]   .EnableEvents = True[/COLOR]
[COLOR=blue]End With[/COLOR]
'SON = Time
   ' MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
    "İşlem süresi ; " & Format((SON - İLK), "hh:mm:ss")
End Sub
Genişletmek için tıkla ...

Çok teşekkür ederim. Emeğinize sağlık. gerçekten çok hızlı
 
Rica ederim, ama ben bir şey yapmadım. Sadece Sayın Korhan Ayhan ın ve Sayın Mancubus un kodlarının bir kısmını sizin kodlarınıza ekledim. :)
 
Korhan Ayhan' Alıntı:
Selamlar,

Filtre uygulamadan yapmak isterseniz sizin ilk mesajınızda yazan kodu kullanmanız gerekir. Fakat bu yöntemde çok satırlı datalarda yavaşlamaya sebep olacaktır. Bu sebeple filtre yöntemini kullanarak çözüm sunmuştum.

Hata aldığınız dosyayı eklemeniz mümkünse hatanın sebebini kontrol edebiliriz.
Genişletmek için tıkla ...

Size de çok teşekkür ederim. gecenin bu saatinde yardımcı oldunuz.Allah razı olsun
 
Selamlar

arkadaşlar aklıma bir fikir geldi ama makro bilgim kıt olduğundan normal
üsülle anlatacağım makrosunu yapan arkadaşlar olursa sevinirim

A sutunuda 65535 satıra kadar x girildiğini bir kaç tanede farklı ifade kullanıldığını
varsayalım
A sutunu
a
s
ffg
s
x
as
x
x
x
x
x
x
gibi
A sutununu kople seçiyoruz ve Düzen menüsünden değiştire aranana x yazalım
tümünü değitir dediğimizde x'ler temizlenecek
2 etapta
tekrar A sutununu kople seçip Düzen menüsünde git menüsü/seçeneklerden/boşlukları
işaretliyip tamam diyiyorum
3.etapta
boşluklar seçili iken
A sutunuda iken sağ klik ve sil diyoruz

Makro ile yapılırsa silem işlemi çok zaman alırmı bilmiyorum


Saygılar
 
Selamlar
makro kaydet ile bir şeyler yaptım
Kod: 
Sub Makro2()
'
' Makro2 Makro
' Makro Admin tarafından 03.03.2011 tarihinde kaydedildi.
'

'
    Columns("A:A").Select
    Selection.Replace What:="x", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp
   
End Sub

Saygılar?
 
Son düzenleme:
Merhaba,

Tablo düzeni buna uygun olursa bencede daha hızlı olur. Yalnız tabloda x leri silmeden önce boş olan satırlar varsa bunlarda silinir.

Daha önemlisi, tabloda ömerxömer gibi veri varsa bu verilerdeki x lerde silinerek veri ömerömer şeklini alır.

Bundan dolayı bu yol her tabloya uygun olmayabilir.

Daha sade kod:

Kod: 
Sub BulTemizleSil()
 
    With Columns("A:A")
        .Replace "x", ""
        .SpecialCells(xlCellTypeBlanks).Delete
    End With
 
End Sub

.
 
Selamlar
Sayın Ömer
LookAt:=xlPart
ibaresini kodda
LookAt:=xlWhole
değiştirince cümle içindeki X'leri silmiyor

Saygılar;
 
Evet o işlemi o şekilde aşabiliriz. Yalnız işlemden önceki boş satır olayı problem yaratabilir.

Gerçi onun içinde işlemden önce boş satırların yerine nadir kullanılan bir değer verilerek işlemden sonra silinebilir.

.
 
Son hali bu şekilde olabilir.

Kod: 
Sub BulTemizleSil()
 
Dim son As Long
son = Cells(Rows.Count, "A").End(xlUp).Row
On Error Resume Next
 
    With Range("A1:A" & son)
        .SpecialCells(xlCellTypeBlanks) = "-+|%!"
        .Replace "x", "", xlWhole
        .SpecialCells(xlCellTypeBlanks).Delete
        .Replace "-+|%!", "", xlWhole
    End With
 
End Sub
.
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst