sıfırlar silinsin

[b_balban]

Merhaba Arkadaşlar

Aşağıdaki kodu tüm çalışma kitabına nasıl uygularım.amaç; b sütununda yer alan tüm 0 lar otomatik olarak silecek.asağıdaki kod tek sayfada işe yarıyor benim çalışma kitabım 40 sayfa hepsinde işe yaramasını istiyorum.



Sub auto_open()
For i = 2 To Range("A1").End(xlDown).Row
If Cells(i, 2) = "0" Then Cells(i, 2).ClearContents
'If Cells(i, 2) = "0" Then Cells(i, 2)=""
Next i
End Sub

 

[Ömer]

Merhaba,

Bu şekilde deneyiniz.

Sub Auto_Open()
 
    Dim i As Integer
    
    For i = 1 To Sheets.Count
         Sheets(i).[B:B].Replace "0", "", xlWhole
    Next i
    
End Sub

.

 

[b_balban]

Merhaba,

Teşekkür ederim fakat 0 ları silmedi modüle oluşturup yapıştırdım ama olmadı.Ben mi yanlış yaptım acaba.

Örnek dosyayı ekliyorum

 

[ynmcan]

Merhaba,

Teşekkür ederim fakat 0 ları silmedi modüle oluşturup yapıştırdım ama olmadı.Ben mi yanlış yaptım acaba.

Örnek dosyayı ekliyorum

Makro kullanmadan formülleri Eğer "0" İse şeklinde yazınız.

=EĞER('C:\DOCUME~1\BAHTIY~1\LOCALS~1\Temp\Rar$DI00.813\proje\[K1.xls]90 30 010 Stock'!B4=0;"";'C:\DOCUME~1\BAHTIY~1\LOCALS~1\Temp\Rar$DI00.813\proje\[K1.xls]90 30 010 Stock'!B4)

 

[b_balban]

teşekkür ederim fakat benim işi macro çözer.çünkü veriler günlük olarak değişiyor ve hergün farklı doya isimleri işin içine giriyor. durum böle olunca hergün formülü deiştirmek zorunda kalcam.

macro koduna ihtiyacım var

 

[Ömer]

durum böle olunca hergün formülü deiştirmek zorunda kalcam.

Silmek istediğiniz aralık formüllü hücre olduğu için bu haliyle "bul/değiştir" işe yaramaz. Kodlar daha hızlı çalışsın diye bu metod ile yazmıştım.

İsterseniz yeniden düzenleyebilirim, Yalnız makro ile silince de formülü silmek zorunda kalacaksınız. Bana pek mantıklı gelmedi. Formülü değiştirmek daha mantıklı değil mi. Yada biçimide değiştirebilirsiniz.

Bu şekilde denermisiniz. İşinize yarar sanırım. Hem formülleri de silmemiş olursunuz..

Sub Auto_Open()
 
    Dim i As Integer
 
    For i = 1 To Sheets.Count
         Sheets(i).[B:B].NumberFormat = "[=0]"""";General"
    Next i
 
End Sub

.

 

[b_balban]

Ömer Bey teşekkür ederim 0 ları silmemdeki amaç ekteki gibiydi aslında.Eki mümkünse inceler misiniz.0 ları silerken formülünde silinmesi lazım.
rapor dosyasında bulabilirsiniz ayrıntılı.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub TÜM_SAYFALARDAKİ_SIFIRLARI_SİL()
    Dim SAYFA As Worksheet, HÜCRE As Range
    
    Application.ScreenUpdating = False
        
    For Each SAYFA In ThisWorkbook.Worksheets
        For Each HÜCRE In SAYFA.Range("A:B").CurrentRegion
            If HÜCRE.Value <> "" And HÜCRE.Value = 0 Then HÜCRE.Value = Empty
        Next
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[b_balban]

Merhaba,

Verdiğiniz kodu başka bie excelde dosyasında denediğimde oluyor fakat userformlu kendi projemde denedğimde olmuyor.kodu engelleyen bi şey mi var acaba.

eki incerler misiniz

 

[Ömer]

Merhaba,

Alternatif olsun;

Sub Degistir()
 
    Dim i As Integer, c As Range, IlkAdres As String
 
    For i = 1 To Sheets.Count
        With Sheets(i)
            Set c = .[B:B].Find(0, LookIn:=xlValues, LookAt:=xlWhole)
            If Not c Is Nothing Then
                IlkAdres = c.Address
                Do
                    .Range("B" & c.Row).ClearContents
                    Set c = .[B:B].FindNext(c)
                Loop While Not c Is Nothing
            End If
        End With
    Next i
 
End Sub

.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub TÜM_SAYFALARDAKİ_SIFIRLARI_SİL()
    Dim SAYFA As Worksheet, HÜCRE As Range
    
    Application.ScreenUpdating = False
        
    For Each SAYFA In ThisWorkbook.Worksheets
        For Each HÜCRE In SAYFA.Range("A7:B" & SAYFA.Range("A65536").End(3).Row)
            If HÜCRE.Value <> "" And HÜCRE.Value = 0 Then HÜCRE.Value = Empty
        Next
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[b_balban]

Çok teşekkür ederim bu kod işimi gördü.