Soru Makro ile Toplu Değere Köprü Ekleme

[KYenerSelvi]

Örnek Dosya Ek'te Arkadaşlar,

Kontrol sayfasında doğru, yanlış ve veri yok olarak formül ile hesaplama yaptırdığım alan mevcut.

B8:H508 Arasında Formül sonucu Yanlış çıkar ise o yanlış yazılarına köprü eklemek istiyorum. Köprü yolunu da formül içerisinden almasını istiyorum. Amacım sonuç yanlış çıkar ise üzerine tıkladığında hatalı hücreye gitmesi.

Birde Temizle makrosu lazım. Sürekli sayfalar güncellendiği için temizle butonuna basınca B8:H508 arasındaki tüm köprüleri kaldırıcak.

 

[KYenerSelvi]

Örnek Dosya Ek'te Arkadaşlar,

Kontrol sayfasında doğru, yanlış ve veri yok olarak formül ile hesaplama yaptırdığım alan mevcut.

B8:H508 Arasında Formül sonucu Yanlış çıkar ise o yanlış yazılarına köprü eklemek istiyorum. Köprü yolunu da formül içerisinden almasını istiyorum. Amacım sonuç yanlış çıkar ise üzerine tıkladığında hatalı hücreye gitmesi.

Birde Temizle makrosu lazım. Sürekli sayfalar güncellendiği için temizle butonuna basınca B8:H508 arasındaki tüm köprüleri kaldırıcak.

Çözüldü: Gerek kalmadı araştırarak şöyle bir alternatif buldum. Excel>Seçenekler>Gelişmiş>Doğrudan hücre içinde düzenleme yapmaya izin ver seçeneğini kaldırın. Formüle çift tıklayınca kaynak yere gidiyor otomatik.

 

[AdemCan]

Merhaba, konu çözülmüş ancak makro olarak da alternatif olması açısından örnek kod hazırladım.

Sub test1()
'Köprü Ekle
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Kontrol Alanı")
Set s2 = Sheets("Güncel Liste")

For i = 9 To s1.Cells(Rows.Count, 2).End(3).Row
    For s = 3 To 9
        If IsError(s1.Cells(i, s).Value) Then GoTo atla
        If s1.Cells(i, s) = "Yanlış" Or s1.Cells(i, s) = "YANLIŞ" Then
            ActiveSheet.Hyperlinks.Add s1.Cells(i, s), Address:="", _
            SubAddress:="'" & s2.Name & "'!" & Cells(i - 7, s - 1).Address
        End If
atla:
    Next s
Next i
Application.ScreenUpdating = True
End Sub

Sub test2()
'Köprü Kaldır
Application.ScreenUpdating = False
Dim s1 As Worksheet
Set s1 = Sheets("Kontrol Alanı")

For i = 9 To s1.Cells(Rows.Count, 2).End(3).Row
    For s = 3 To 9
        With s1.Cells(i, s)
            .Hyperlinks.Delete
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Borders(xlEdgeLeft).LineStyle = xlDouble
            .Borders(xlEdgeTop).LineStyle = xlDouble
            .Borders(xlEdgeBottom).LineStyle = xlDouble
            .Borders(xlEdgeRight).LineStyle = xlDouble
        End With
    Next s
Next i
Application.ScreenUpdating = True
End Sub