Değeri "0" olan hücre

[krmtr]

A sütununda değeri sıfır olan hücreyi yurarıya sürükleyerek silmesini istiyorum.
Şimdiden teşekkürler.

 

[Ömer]

Merhaba,

Module kopyalarak çalıştırınız..

Sub SıfırSil()
 
Dim son As Long, i As Long
 
son = Cells(Rows.Count, "A").End(xlUp).Row
For i = son To 1 Step -1
    If Cells(i, "A") = 0 And Cells(i, "A") <> "" Then
        Rows(i).Delete Shift:=xlUp
    End If
Next i
 
End Sub

.

 

[truvali27m]

A sütununda değeri sıfır olan hücreyi yurarıya sürükleyerek silmesini istiyorum.
Şimdiden teşekkürler.

Merhaba,dediğiniz aşağıdaki kodlarla yapılabilir:


Sub Sifirlari_sil()
Dim i As Integer
For i = 1 To 10
If Cells(i, "a").Value = 0 Then
Cells(i, "a").Delete shift:=xlUp






End If
Next i
End Sub

 

[truvali27m]

Merhaba,

Module kopyalarak çalıştırınız..

Sub SıfırSil()
 
Dim son As Long, i As Long
 
son = Cells(Rows.Count, "A").End(xlUp).Row
For i = son To 1 Step -1
    If Cells(i, "A") = 0 And Cells(i, "A") <> "" Then
        Rows(i).Delete Shift:=xlUp
    End If
Next i
 
End Sub

.

Pardon Ömer Bey sizin yazdığınızı görmemiştim

 

[Ömer]

Pardon Ömer Bey sizin yazdığınızı görmemiştim

Sorun değil Sayın truvali27m. Yalnız satır silme de artan döngü kullanırsanız hata alırsınız. Bu yüzden dönügüyü sondan başa doğru kurmak daha doğru olacaktır.

İyi çalışmalar..

.

 

[truvali27m]

Sorun değil Sayın truvali27m. Yalnız satır silme de artan döngü kullanırsanız hata alırsınız. Bu yüzden dönügüyü sondan başa doğru kurmak daha doğru olacaktır.

İyi çalışmalar..

.

Doğru diyorsunuz Ömer Bey,ben de öğrenmiş oldum.Kodları daha yeni öğreniyoruz ama ince detaylarını da sizler sayesinde öğrenmiş oluyoruz.Size de iyi çalışmalar.

 

[krmtr]

Merhaba,

Module kopyalarak çalıştırınız..

Sub SıfırSil()
 
Dim son As Long, i As Long
 
son = Cells(Rows.Count, "A").End(xlUp).Row
For i = son To 1 Step -1
    If Cells(i, "A") = 0 And Cells(i, "A") <> "" Then
        Rows(i).Delete Shift:=xlUp
    End If
Next i
 
End Sub

.

Teşekkürler tekrar. 500.000 satırlık veride uzunsürecek ama başlattım çalışmaya.

 

[Ömer]

Teşekkürler tekrar. 500.000 satırlık veride uzunsürecek ama başlattım çalışmaya.

Birde aşağıdaki kodları denermisiniz..

Sub SifirSil()
 
Dim son As Long
son = Cells(Rows.Count, "A").End(xlUp).Row
On Error Resume Next
 
    With Range("A1:A" & son)
        .SpecialCells(xlCellTypeBlanks) = "-+|%!"
        .Replace 0, "", xlWhole
        .SpecialCells(xlCellTypeBlanks).Delete
        .Replace "-+|%!", "", xlWhole
    End With
 
End Sub

.

 

[Seyit Tiken]

Bu kod nisbetten hızlı olabilir.

Sub Makro3()
[a1:a50000].Replace What:=0, Replacement:=Delete
[a1:a50000].SpecialCells(4).Rows.Delete Shift:=xlUp
End Sub

 

[krmtr]

Birde aşağıdaki kodları denermisiniz..

Sub SifirSil()
 
Dim son As Long
son = Cells(Rows.Count, "A").End(xlUp).Row
On Error Resume Next
 
    With Range("A1:A" & son)
        .SpecialCells(xlCellTypeBlanks) = "-+|%!"
        .Replace 0, "", xlWhole
        .SpecialCells(xlCellTypeBlanks).Delete
        .Replace "-+|%!", "", xlWhole
    End With
 
End Sub

.

"A" sütunundaki bütün verileri kaybettim.

 

[krmtr]

Merhaba,

Module kopyalarak çalıştırınız..

Sub SıfırSil()
 
Dim son As Long, i As Long
 
son = Cells(Rows.Count, "A").End(xlUp).Row
For i = son To 1 Step -1
    If Cells(i, "A") = 0 And Cells(i, "A") <> "" Then
        Rows(i).Delete Shift:=xlUp
    End If
Next i
 
End Sub

.

Bide ben bu kodu çalışma kitabı içerisindeki tüm sayfalar için aynı anda çalıştırabilir miyim?

 

[Ömer]

"A" sütunundaki bütün verileri kaybettim.

Bunun olacağını sanmıyorum. Bu şekilde olan dosyayı uygulama yapmadan ekmeniz mümkün mü?

.

 

[krmtr]

Ekte satır eksiltilmiş ve kodsuz olarak mevcut
İlginiz için teşekkürler.

 

[Ömer]

Kodlar düzgün çalıştı. Sadece 0 olanları sildi.

Problem nedir ?

.

 

[Ömer]

Karışıklık olmuş. Diğer koddan bahsediyormuşsunuz.

Seçim alanı büyük olduğu için problem çıkardı. Daha müsait bir zamanda o konuyu araştırırım.

Eğer verilerin sıralamasında bir sakınca yoksa aşağıdaki kodlar diğerlerine göre çok daha hızlı silecektir.

Sub SıfırSil()
 
Dim son As Long, say As Long
 
son = Cells(Rows.Count, "A").End(xlUp).Row
 
Range("A1:A" & son).Sort Range("A1")
If Range("A1") <> 0 Then Exit Sub
 
say = WorksheetFunction.CountIf(Range("A1:A" & son), 0)
 
Rows("1:" & say).Delete
 
End Sub

 

[krmtr]

Birde aşağıdaki kodları denermisiniz..

Sub SifirSil()
 
Dim son As Long
son = Cells(Rows.Count, "A").End(xlUp).Row
On Error Resume Next
 
    With Range("A1:A" & son)
        .SpecialCells(xlCellTypeBlanks) = "-+|%!"
        .Replace 0, "", xlWhole
        .SpecialCells(xlCellTypeBlanks).Delete
        .Replace "-+|%!", "", xlWhole
    End With
 
End Sub

.

Bu kodlar mı düzgün çalıştı.
İlk verdikleriniz çalışıyor sorun yok.
Bunu da denememi istediğiniz için denedim ama A sütunundaki verilerin tatamı silindi ve yerine B sütunundaki veriler geçti.