Sondan Başa Doğru Ara Bul

[askm]

Kolay gelsin.
B sütununda Aktif hücrenin mükerrer kaydının adresini d sütununa yazdırmak istiyorum. Yalnız 2 den fazla kayıt varsa en son kaydın adresini D sütununa yazacak ve o adrese köpru oluşturacak. Mümkün müdür?

 

[asi_kral]

Merhaba
Dosya ekler misiniz ?

 

[askm]

Dosya ektedir.

 

[asi_kral]

Merhaba
Sayfanın kod bölümüne kopyalayıp dener misiniz ?

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ARA As Range, STR As String, SBT As String
If Target.Column = 2 Then
If WorksheetFunction.CountIf(Range("B2:B" & Target.Row), Target) > 1 Then
Set ARA = Range("B1:B" & Target.Row - 1).Find(Target, , , xlWhole)
SBT = ARA.Address
Do
STR = ARA.Address
Set ARA = Range("B1:B" & Target.Row - 1).FindNext(ARA)
Loop While Not ARA Is Nothing And ARA.Address <> SBT
Range("D" & Target.Row) = Replace(STR, "$", "")
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 4 Then
Range(Target.Text).Select
End If
End Sub

 

[askm]

İlginiz ve bilginiz için çok teşekkürler.

 

[askm]

Örneğin B2918 de işlem yaptım ve D ye B2897 adresini yazdı. Bu adrese köprü nasıl oluşturabilirim.

 

[Ömer BARAN]

Merhaba. Alternatif olsun.

Alt taraftan ilgili sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde açılan VBA ekranında sağ taraftaki boş alana yapıştırın.
B sütununda değişiklikler yaparak ve D sütunundaki dolu hücrelere tıklayarak sonucu gözlemleyin.
.

[FONT="Arial Narrow"][B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Target.Column <> 2 Then Exit Sub
If Target.Column = 2 And Target <> "" Then
    Call SONUNCUNUN_ADRESİ
End If
[B]End Sub[/B]

[B]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/B]
    If Target.Column = 4 And Target <> "" Then Range(Target.Value).Activate
[B]End Sub[/B]

[B]Sub SONUNCUNUN_ADRESİ()[/B]
Range("D:D").ClearContents
For satır = [B65536].End(3).Row To 2 Step -1
If WorksheetFunction.CountIf(Range(Cells(satır + 1, 2), Cells([B65536].End(3).Row + 1, 2)), Cells(satır, 2)) > 0 Then GoTo 10
If WorksheetFunction.CountIf(Range(Cells(satır - 1, 2), Cells(2, 2)), Cells(satır, 2)) > 0 Then
    For sat = satır - 1 To 2 Step -1
    If Cells(sat, 2) = Cells(satır, 2) Then
        Cells(satır, 4) = "B" & sat: Exit For: End If: Next: End If
10: Next
[B]End Sub[/B][/FONT]

 

[asi_kral]

Örneğin B2918 de işlem yaptım ve D ye B2897 adresini yazdı. Bu adrese köprü nasıl oluşturabilirim.

Köprü zaten oluşturulmuştu. O hücreye tıklayın dilediğiniz hücreye sizi götürecek.