Hyperlink kurma

[ecalhan]

Arkadaşlar merhaba. Şöyle bir makrro yapmak istiyorum ancak nasıl olacağını bilmiyorum. Sıra ile 1sheet a sütunudaki hücre içerisindeki değeri okuyacak ve 2.sheetdeki b sütununda yer alan değerlerle karşılaştıracak eğer hücre içerikleri aynı ise 1.sheet deki hücreyi 2.sheetdeki hücre ile hyperlink kuracak. Böyleilkle her iki sheetdeki sütunları karşılaştırarak sheetler arasındaki hyperlink tamamlanacak.Acaba bunun için bana herhangi bir örnek çalışma gönderebilirmisiniz?

 

[tahsinanarat]

Eğer dediğinizi doğru anladıysam, aşağıdaki kodu bir denermisiniz.

Sub Koprukur()
Worksheets("Sheet1").Range("A2:A65536").Hyperlinks.Delete
Worksheets("Sheet2").Range("A2:A65536").Hyperlinks.Delete
For Each c In Worksheets("Sheet1").Range("A2:A65536")
If c.Value <> "" Then
bul = c.Value
If bul <> "" Then
Set d = Worksheets("Sheet2").Range("A2:A65536").Find(bul, LookAt:=xlWhole)
If Not d Is Nothing Then
firstAddress = d.Address
Do
On Error Resume Next
Worksheets("Sheet1").Range(c.Address).Hyperlinks.Add Anchor:=Worksheets("Sheet1").Range(c.Address), Address:="", SubAddress:="Sheet2!" & firstAddress
Worksheets("Sheet2").Range(d.Address).Hyperlinks.Add Anchor:=Worksheets("Sheet2").Range(d.Address), Address:="", SubAddress:="Sheet1!" & Worksheets("Sheet1").Range(c.Address).Address
Set d = Worksheets("Sheet2").Cells.FindNext(d)
Loop While Not d Is Nothing And d.Address <> firstAddress
End If
End If
End If
Next c
End Sub

 

[ecalhan]

Tahsin, her şeyden öncedesteğin için tşk ederim. ancak nedense macro Delete komutuna kızıyor. compile error, invaild or unqualified refernece hatası veriyor.

 

[Huseyinkis]

Tahsin, her şeyden öncedesteğin için tşk ederim. ancak nedense macro Delete komutuna kızıyor. compile error, invaild or unqualified refernece hatası veriyor.

Merhaba yukarıdaki kodlarda Hyperlinks .Delete yazılışında Hyperlinks den sonra " " boşluk var eğer sizin dosyadada aynısı varsa boşluğu kaldırıp denermisiniz.

 

[tahsinanarat]

evet boşlukların olmaması gerekli, birde sayfanızın sekme isimlerini kontrol ediniz. Ben şimdi denedim çalışıyor. Birde koddaki "Hyperlinks.Add Anchor" Hyperlinks.A dd Anchor şeklinde ayrı görünüyor o boşluğuda alınız.
Yada en iyisi dosya içerisinde göndereyim.
Sub Koprukur()
Worksheets("Sayfa1").Range("A2:A65536").Hyperlinks.Delete
Worksheets("Sayfa2").Range("A2:A65536").Hyperlinks.Delete
For Each c In Worksheets("Sayfa1").Range("A2:A65536")
If c.Value <> "" Then
bul = c.Value
If bul <> "" Then
Set d = Worksheets("Sayfa2").Range("A2:A65536").Find(bul, LookAt:=xlWhole)
If Not d Is Nothing Then
firstAddress = d.Address
Do
On Error Resume Next
Worksheets("Sayfa1").Range(c.Address).Hyperlinks.Add Anchor:=Worksheets("Sayfa1").Range(c.Address), Address:="", SubAddress:="Sayfa2!" & firstAddress
Worksheets("Sayfa2").Range(d.Address).Hyperlinks.Add Anchor:=Worksheets("Sayfa2").Range(d.Address), Address:="", SubAddress:="Sayfa1!" & Worksheets("Sayfa1").Range(c.Address).Address
Set d = Worksheets("Sayfa2").Cells.FindNext(d)
Loop While Not d Is Nothing And d.Address <> firstAddress
End If
End If
End If
Next c
End Sub

 

[ecalhan]

Haklıymışsınız macro çalıştı. İlginiz ve desteğiniz için tşk ederim.