Rectangle'ye bağlı formüller

[tahsinanarat]

Rectangle 10 içersinde =exsport!B12
Rectangle 10 =exsport!b13
Rectangle 10 =exsport!b14
Rectangle 10 =exsport!b15 vs.
şeklinde devam eden formül bağlantılarım var.

Ben bu kutucuklar içerisine tek tek girip formülleri değiştirebiliyorum. Ben toplu halde =exsport!b12 "b" değerini "c" değeri ile bir seferde değiştirmek istiyorum.
Bu konuda bilgisi olan arkadaşlarımın yardımlarını bekliyorum.

 

[kemalist]

Ctrl+ F yap Değiştir de değiştirilecek değeri altada istenen değeri yaz Tümünü değiştire tıkla.

 

[tahsinanarat]

Sn. Kemalist, şekillerdeki (rectangle) formüller için bu dediğiniz olmuyor. ilginiz için teşekkür ederim.

 

[Merhum İdris SERDAR]

.

exsport sayfasındaki
C12
..........
.............
..........

değerleri

exsport sayfasının

B12
--
...
....

kopyalayın.

B12 ve altını kes, yapıştırla C12'ye taşıyın.


.

 

[tahsinanarat]

sn. idris hocam yarın işyerinde deneyip sonucu bildireceğim, olumlu sonuç verecek gibi. Teşekkür ederim.

 

[Korhan Ayhan]

Alternatif;

Sub Makro()
    Dim Nesne As Shape
    With Sheets("Sayfa1")
        For Each Nesne In .Shapes
            If InStr(1, Nesne.DrawingObject.Formula, "!B") > 0 Then
                Nesne.DrawingObject.Formula = Replace(Nesne.DrawingObject.Formula, "!B", "!C")
            End If
        Next
    End With
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[tahsinanarat]

Örnek dosyayı ekte gönderiyorum

Korhan hocam, Uyarlamaya çalıştığım dosyada hata verdi, dosyayı ekte gönderiyorum, Bakabilirseniz sevinirim.

 

[tahsinanarat]

Korhan hocam olayı şimdi çözdüm, şekillerin seçili olması gerekiyormuş, aynı kod içerisinde şekilleri seçili hale getirip kod çalıştırabilirsek daha mükemmel olacak.

 

[Korhan Ayhan]

Şekillerin seçili olmasına gerek yok.

Dosyanıza göre hangi formüllerin değişmesi gerekiyor.

 

[tahsinanarat]

Evet hocam, sonradan fark ettim seçili olmadan da çalışıyor, saadece şöyle bir durum var, b den c ye dönüştürdüğünü tekrar tersini yapmıyor, yani b den c ye döndürdüğün zaman c den b ye geri dönüştürmüyor hata veriyor, ancak değişmeyen formüller de başka değişikliklere devam edebiliyorsun, bu şekilde de idare eder. Saadece marakımdan sordum. Elinize sağlık. Sağolun.

 

[Korhan Ayhan]

Tahsin Bey,

Şartlar uygunsa B'yi "C" yapan kod neden tam tersini yapmasın. Bence atladığınız bir detay vardır. Sakin bir şekilde yeniden kontrol edin.

 

[tahsinanarat]

Hata mesajı

Korhan hocam, şu an eve geldim, ne yaptımsa hiç çalışmadı, ekteki hata mesajını alıyorum.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub Makro()
    Dim Nesne As Shape
    With Sheets("Fatih_Fatura2")
        For Each Nesne In .Shapes
            If Left(Nesne.Name, 9) = "Rectangle" Then
                If InStr(1, Nesne.DrawingObject.Formula, "exsport!B") > 0 Then
                    Nesne.DrawingObject.Formula = Replace(Nesne.DrawingObject.Formula, "!B", "!C")
                End If
            End If
        Next
    End With
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[tahsinanarat]

Korhan hocam kod çalıştı ama dediğim gibi harf değişikliği yaptığın harfi bir başka harfe çevirmiyor, örneğin AA harflerini X yaptım, aslında U yapmam gerekiyormuş, yaptığım X leri
U ya çevirirken hata veriyor, sonrada makro görevini yapıyor gibi görünse de değişikliği yapmıyor.

 

[Korhan Ayhan]

Üyemizin sistemine uzak bağlantı ile bağlanıp sorunu beraber inceledik. Makro bir şekilde şekillerdeki formüllere boşluk karakteri eklediği için sorun oluşmuş. TRIM fonksiyonu ile çözüm üretilmiştir.

Sub Makro()
    Dim Nesne As Shape
    With Sheets("Fatih_Fatura2")
        For Each Nesne In .Shapes
            If Left(Nesne.Name, 9) = "Rectangle" Then
                If InStr(1, Nesne.DrawingObject.Formula, "exsport!B") > 0 Then
                    Nesne.DrawingObject.Formula = Replace(Trim(Nesne.DrawingObject.Formula), "!B", "!C")
                End If
            End If
        Next
    End With
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[tahsinanarat]

Seçili olan şekillerde değişiklik

Korhan hocam kodlarınız sorunsuz olarak çalıştı.
Eğer saadece seçili olan şekillerde değişiklik yapmak istersek kodunuzda nasıl bir değişiklik yapmamız gerekecek.
Ayrıca değişiklik yapılan şekillerin fontlarının 8 olmasını da sağlayabilirmiyiz

Sub Makro2()
    Dim Nesne As Shape
    With Sheets("Fatih_Fatura2")
        For Each Nesne In .Shapes
            If Left(Nesne.Name, 9) = "Rectangle" Then
                If InStr(1, Nesne.DrawingObject.Formula, "exsport!H") > 0 Then
                    Nesne.Select
                    Nesne.DrawingObject.Formula = Replace(Trim(Nesne.DrawingObject.Formula), "!H", "!B")
                    Say = Say + 1
                End If
            End If
        Next
    End With
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & "Değişiklik sayısı : " & Say, vbInformation
End Sub

 

[Korhan Ayhan]

Seçili şekillerden kastınız belli hücre aralığındaki şekiller mi?

 

[tahsinanarat]

Evet hocam öylede diyebiliriz, yada şekilleri seçerek de olabilir.

 

[Korhan Ayhan]

Deneyiniz.

Mouse ile seçtiğiniz hücrelerde çalışır. Eğer alan belirlemek isterseniz Set Alan = Selection bölümündeki "Selection" ifadesi yerine Range("A1:C20") gibi aralık tanımlayabilirsiniz.

Sub Makro()
    Dim Nesne As Shape, Alan As Range
    
    Set Alan = Selection
    
    For Each Nesne In ActiveSheet.Shapes
        If Not Intersect(Nesne.TopLeftCell, Alan) Is Nothing Then
            If Left(Nesne.Name, 9) = "Rectangle" Then
                If InStr(1, Nesne.DrawingObject.Formula, "exsport!H") > 0 Then
                    'Nesne.Select
                    Nesne.DrawingObject.Formula = Replace(Trim(Nesne.DrawingObject.Formula), "!H", "!B")
                    Nesne.DrawingObject.Font.Size = 8
                    Say = Say + 1
                End If
            End If
        End If
    Next
    
    Alan.Select
    
    If Say > 0 Then
        MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & "Değişiklik sayısı : " & Say, vbInformation
    Else
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
End Sub

 

[tahsinanarat]

Korhan hocam elinize sağlık, Range olarak alan belirttiğimde hata vermiyor, ancak Set Alan = Selection olarak belirttildiğinde bu satırda Run time error '13': hatası veriyor. Bilginiz olsun.