öncelikle dosyanız xlsm yada xlsb olmalı
1 - çalışmanıza bir modül ekleyin
modüle eklenecek kod:
Function AdresIlIlce(ByVal Rng As Range) ' As String
Dgr = ""
If Len(Rng.Value & "") = 0 Then GoTo Son
Dgr = Trim(Rng.Value)
Dgr = Mid(Dgr, InStrRev(Dgr, " ") + 1)
Son:
Rng.Offset(, 2) = Dgr
End Function
2 - veri sayfasının kod sayfasına aşağıdaki kodu ekleyin
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("K:K")) Is Nothing Then 'sadece K sütununa bakar
Dim cll As Range
AdrX = Target.Address
If InStr(AdrX, ":") > 0 Then ilk = Split(AdrX, "$")(2): Son = Split(AdrX, "$")(4) Else ilk = Split(AdrX, "$")(2) & ":": Son = Split(AdrX, "$")(2)
Set Trgt = Range("K" & ilk & "K" & Son)
For Each cll In Trgt
Set Rng = cll
AdresIlIlce (Rng)
Next cll
End If
End Sub
dilerim işinize yarar