Çözüldü Hücredeki Formül İçindeki Formülleri Silme

[Leonenengineer]

L8 satırında =YUVARLA(H8-J8;2) formülüm mevcut. Burada Yuvarla formülünü iptal edip =H8-J8 olarak yeniden düzenlemek istiyorum.

Burada L8 den başlayıp aynı formül aşağı doğru ve ayrıca 50 den fazla sayfada da aynı düzende olmak üzere devam ediyor.

Sorum; bunu otomatik olarak yapacak, sadece L sütunundaki YUVARLAMA formülüne yapıp diğer hücrelerdeki ve L sütunundaki diğer formüllere zarar vermeyecek şekilde gerçekleştirecek bir çözüm var mıdır?

 

[Korhan Ayhan]

Olası veri kaybına karşı dosyanızı yedekleyerek deneyiniz.

Option Explicit

Sub Remove_Round()
    Dim Sh As Worksheet, Rng As Range, Formula_Rng As Range, Search_Formula As String
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Search_Formula = "=ROUND("
    
    For Each Sh In ThisWorkbook.Sheets
        On Error Resume Next
        Set Formula_Rng = Nothing
        Set Formula_Rng = Sh.Range("L:L").SpecialCells(xlCellTypeFormulas, 23)
        On Error GoTo 0
        If Not Formula_Rng Is Nothing Then
            For Each Rng In Formula_Rng
                If Rng.HasFormula Then
                    If InStr(1, Rng.Formula, Search_Formula) > 0 Then
                        Rng.Formula = Replace(Replace(Rng.Formula, Search_Formula, "="), ",2)", "")
                    End If
                End If
            Next
        End If
    Next
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[kulomer46]

Merhaba

Alternatif Çalışma

Olası veri kaybına karşı dosyanızı yedekleyerek deneyiniz

Selamlar...

Ekran Resmi

 

[Leonenengineer]

Merhabalar, ekli dosyanız

Merhaba

Alternatif Çalışma

Olası veri kaybına karşı dosyanızı yedekleyerek deneyiniz

Selamlar...

Ekran Resmi
Ekli dosyayı görüntüle 242455

MErhabalar, yanıtınız için teşekkür ederim ama ekli dosya hata veriyor.

 

[Leonenengineer]

Olası veri kaybına karşı dosyanızı yedekleyerek deneyiniz.

Option Explicit

Sub Remove_Round()
    Dim Sh As Worksheet, Rng As Range, Search_Formula As String
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Search_Formula = "=ROUND("
   
    For Each Sh In ThisWorkbook.Sheets
        For Each Rng In Sh.Range("L:L").SpecialCells(xlCellTypeFormulas, 23)
            If Rng.HasFormula Then
                If InStr(1, Rng.Formula, Search_Formula) > 0 Then
                    Rng.Formula = Replace(Replace(Rng.Formula, Search_Formula, "="), ",2)", "")
                End If
            End If
        Next
    Next
   
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Yanıt için teşekkür ederim. İşe yarıyor. Emin olmak için soruyorum sadece L sütünu içindir değil mi ve ayrıca makroyu çalıştırınca sadece aktif sayfa da mı oluyor yoksa tüm sayfalarda mı?

 

[Korhan Ayhan]

Tüm sayfalarda ve sadece L sütunu için çalışmaktadır.

 

[Leonenengineer]

Tüm sayfalarda ve sadece L sütunu için çalışmaktadır.

Teşekkür ederim. Peki belirli sayfalarda yapmak için nasıl bir güncelleme yapabiliriz acaba? Dosya içindeki bazı diğer sayfalarda geçerli olmasını istemiyorum. Acaba sayfa sırasına göre belli aralık seçebilir miyiz?

 

[Korhan Ayhan]

Evet istenilen sayfalarda kodun çalışması sağlanabilir.

Eğer sıralı sayfalarda çalışacaksa mesela ilk 10 sayfada çalış diyebiliriz. Ya da sayfa adı belirterek şu sayfalarda çalış diyebiliriz. Fakat son önerimde eğer işlem yapılacak sayfa sayısı çoksa isim yazmak can sıkıcı olabilir.

 

[Leonenengineer]

Evet istenilen sayfalarda kodun çalışması sağlanabilir.

Eğer sıralı sayfalarda çalışacaksa mesela ilk 10 sayfada çalış diyebiliriz. Ya da sayfa adı belirterek şu sayfalarda çalış diyebiliriz. Fakat son önerimde eğer işlem yapılacak sayfa sayısı çoksa isim yazmak can sıkıcı olabilir.

SAyfa seçme işlemini nasıl koda ekleyebiliriz acaba. kodun içinde mesala 15.sayfa ile 43. sayfa arasında çalışmasını istesek.

 

[Leonenengineer]

SAyfa seçme işlemini nasıl koda ekleyebiliriz acaba. kodun içinde mesala 15.sayfa ile 43. sayfa arasında çalışmasını istesek.

Bir de orjinal odsyamda çalıştırdığımda L sütunu boş olan sayfalar da var bu yüzden "hiç bir hücre bulunmadı" hatası veriyor.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Option Explicit

Sub Remove_Round()
    Dim X As Byte, Sh As Worksheet, Rng As Range
    Dim Formula_Rng As Range, Search_Formula As String
    Dim Count_Change_Cell As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Search_Formula = "=ROUND("
    
    For X = 15 To 43
        On Error Resume Next
        Set Sh = Nothing
        Set Sh = Sheets(X)
        Set Formula_Rng = Nothing
        Set Formula_Rng = Sh.Range("L:L").SpecialCells(xlCellTypeFormulas, 23)
        On Error GoTo 0
        
        If Not Sh Is Nothing Then
            If Not Formula_Rng Is Nothing Then
                For Each Rng In Formula_Rng
                    If Rng.HasFormula Then
                        If InStr(1, Rng.Formula, Search_Formula) > 0 Then
                            Rng.Formula = Replace(Replace(Rng.Formula, Search_Formula, "="), ",2)", "")
                            Count_Change_Cell = Count_Change_Cell + 1
                        End If
                    End If
                Next
            End If
        End If
    Next
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           Format(Count_Change_Cell, "#,##0") & " adet hücrede formül değişikliği yapılmıştır.", vbInformation
End Sub

 

[Leonenengineer]

Merhabalar,

Hata vermiyor ancak 0 hücrede değişiklik yapılmıştır diyor ve formülü kaldırmıyor.

 

[Korhan Ayhan]

O zaman 15 ve 43 arasındaki sayfa sırasında bir sorun var demektir. Bu bahsettiğiniz değerleri ben sayfaların sıra indis numarası (sekmek sırası) olarak dikkate aldım.

 

[Leonenengineer]

Merhabalar,

Düşünceleriniz doğru. Ben de tekrar deneyince mesala 15. sıradaki sayfa oluyor ancak 19. sıradaki sayfada olmuyor. Arada olmayan sayfalar var. 15 ile 43 arasında L satırının boş olduğu sayfalar mevcut.

 

[Korhan Ayhan]

Bu durumda olmayan sayfayıda içeren küçük bir örnek dosya paylaşın bizde deneme yapalım.

 

[Leonenengineer]

Bu durumda olmayan sayfayıda içeren küçük bir örnek dosya paylaşın bizde deneme yapalım.

Şirket için özel dosyalar olduğu için ne kadar sonuca ulaşmak için istesem de paylaşmak benim için sıkıntılı olabilir. Bu nedenle ricam eğer bunu koda dökmek kolay ise ben kendim istediğim sayfalarda önce istediğim sütunları seçip onun ardından makroyu çalıştırarak işe yarayan bir formata döndürmenizdir.

Daha net anlatmak istersek, ben Sayfa1 de L sütununu ya da Sayfa1 L8:K50 aralığını seçip sonra Sayfa 2 L:L Sayfa 3 K5:M89 .... hepsini seçip ardından makroyu çalıştırmak üzere olabilir. Ya da;
Eğer farklı sayfalar kendi içinde zor oluyorsa bir sayfada aralığı seçip makroyu kullandıktan sonra sonraki sayfada işlemi tekrar etmek üzere çalışan bir makroda olabilir.

Sabit olan şey konunun başında olduğu gibi Yuvarla formülünü ortandan kaldırarak geriye kalan formülü çalıştırmak.

 

[Korhan Ayhan]

Önerdiğim kodu boş bir çalışma kitabında çoklu sayfalarda deneyerek paylaşmıştım. Bende çalışıyor sizde sonuç vermemesi garip bir durum. Sayfalarda koruma olabilir mi?

 

[Leonenengineer]

Merhabalar, haftasonu kodu tekrar deneyerek sonucu tekrar ileteceğim. Ancak sayfalarda koruma yok.

 

[Leonenengineer]

Option Explicit

Sub Remove_Round()
    Dim Sh As Worksheet
    Dim Rng As Range
    Dim Formula_Rng As Range
    Dim Search_Formula As String
    Dim Count_Change_Cell As Long
    Dim lastRow As Long
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Search_Formula = "=ROUND("
   
    ' Her bir çalışma sayfası için döngü
    For Each Sh In ThisWorkbook.Sheets
        ' L sütununda son satırı bulun
        lastRow = Sh.Cells(Sh.Rows.Count, "L").End(xlUp).Row
        ' L sütunundaki "ROUND" içeren hücreleri bulun
        Set Formula_Rng = Sh.Range("L1:L" & lastRow).Find(What:=Search_Formula, LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False)
       
        ' "ROUND" fonksiyonu içeren hücreleri bulunduğunda
        If Not Formula_Rng Is Nothing Then
            ' Her bir bulunan hücre için döngü
            Do
                ' "ROUND" fonksiyonunu kaldır
                Formula_Rng.Formula = Replace(Replace(Formula_Rng.Formula, Search_Formula, "="), ",2)", "")
                Count_Change_Cell = Count_Change_Cell + 1
                ' Sonraki "ROUND" fonksiyonu içeren hücreyi bul
                Set Formula_Rng = Sh.Range("L1:L" & lastRow).FindNext(Formula_Rng)
            Loop While Not Formula_Rng Is Nothing
        End If
    Next Sh
   
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           Format(Count_Change_Cell, "#,##0") & " adet hücrede formül değişikliği yapılmıştır.", vbInformation
End Sub

Bu kod ile sorunsuz çözdüm. Fikir öncülüğü için çok teşekkür ederim.