Worksheet selection changes ve bul-değiştir.

[hsayar]

Sub Degistir()
'
' Makro1 Makro
' Makro Hsayar tarafından 10.01.2008 tarihinde kaydedildi.
'

'
    Cells.Replace What:="Caddesi", Replacement:="Caddesi/", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="Sokağı", Replacement:="Sokağı/", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="Cadde Sokak    ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False

End Sub

kodlarını

G sütununda worksheet selection_changede çalışsın. ama nasıl
h sütununda / veriler ayrılsın ve alt alta dizilsin

örneğin c5 hücresine girilen aşağıdaki satır:
Cadde Sokak 10 NOLU ÇIKMAZ Sokağı6 NOLU ÇIKMAZ Sokağı7 NOLU ÇIKMAZ Sokağı8 NOLU ÇIKMAZ Sokağı9 NOLU ÇIKMAZ SokağıAKINCILAR SokağıATATÜRK CaddesiBÜLBÜL SokağıCUMHURİYET CaddesiCUMHURİYET MeydanıDENİZ CaddesiGAZİ İRFAN CaddesiGÜNEŞ SokağıMERİÇ CaddesiSAVRAN SokağıSELVİ CaddesiSERİN SokağıTUNÇ CaddesiYÜZEN SokağıÖZCAN SokağıŞEHİT FERHAT DOĞAN Caddesi

önce c5 te aşğıdaki hale gelecek (mevcut kodla bütün hücrelerde bu hale geliyor)

1 NOLU ARA Sokağı/2 NOLU ARA Sokağı/3 NOLU ARA Sokağı/4 NOLU ARA Sokağı/ALP Sokağı/ATATÜRK Caddesi/BATUR Sokağı/DEMİREL Caddesi/DOĞAN Sokağı/GÖKHAN Sokağı/GÜL Sokağı/GÜNDOĞAN Caddesi/GİDER Sokağı/KANARYA Sokağı/KARTAL Sokağı/KIZIL Sokağı/KORU Sokağı/KOYUNCU Sokağı/LONDRA Caddesi/MENDERES Caddesi/MERİÇ Caddesi/NEKES Sokağı/NEŞE Sokağı/OKUL Sokağı/SAĞLAM Sokağı/SÜLEYMAN DOĞAN Caddesi/TUNÇ Caddesi/ULUBATLI Sokağı/YAVUZ Sokağı/YILDIZ Sokağı/ÇETİN Caddesi/ÖRS Sokağı/ÖZAL Caddesi/İLKAY Sokağı/İNÖNÜ Caddesi/

daha sonra
d5 hücresine 10 NOLU ÇIKMAZ Sokağı
d6 hücresine 6 NOLU ÇIKMAZ Sokağı
d7 hücresine 7 NOLU ÇIKMAZ Sokağı
d8 ................
d9 .................
yazılacak,yardımlarınız için teşekkürler

 

[06eed]

Sub hücre_yaz()
Dim yazı, yazı2() As String
Dim uzunluk, i, j As Integer
yazı = Trim(Cells(5, 3))
uzunluk = Len(yazı)
ReDim yazı2(uzunluk)
j = 0
 
tekrar:
For i = 1 To Len(yazı)
a = Right(yazı, i)
If a Like "/*" Then j = j + 1: yazı2(j) = Right(yazı, i - 1): yazı = Left(yazı, Len(yazı) - i): GoTo tekrar
Next i
 
For i = 1 To j
Cells(4 + i, 4) = yazı2(i)
Next i
 
End Sub

'xxx

Sub değiştir()
Cells.Replace What:="Caddesi", Replacement:="Caddesi/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Sokağı", Replacement:="Sokağı/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="Cadde Sokak ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
End Sub

Hücre yaz macrosu sanırım isteğinizi çözüyor.

 

[hsayar]

hocam ilginize teşekkür ederim tesadüfen sn. zaferin kodlarına rastladım ve kendime uyarladım.

Private Sub Worksheet_Change(ByVal Target As Range)
'zafer/excel.web.tr uyarlama hsayar
If Intersect(Target, [I1:I65536]) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub

   sonsatır = [Q65536].End(3).Row + 1

'MsgBox sonsatır
cumledeki_degerler = Split(Target.Value, "/")
For i = 0 To UBound(cumledeki_degerler)
'Cells(i + 3, 2) = cumledeki_degerler(i)
Cells(sonsatır + i, "Q") = cumledeki_degerler(i)
Cells(sonsatır + i, "K") = Cells(Target.Row, "A")
Cells(sonsatır + i, "L") = Cells(Target.Row, "B")
Cells(sonsatır + i, "M") = Cells(Target.Row, "C")
Cells(sonsatır + i, "N") = Cells(Target.Row, "D")
Cells(sonsatır + i, "O") = Cells(Target.Row, "E")
Cells(sonsatır + i, "P") = Cells(Target.Row, "F")
Next
End Sub

yarın vaktim olursa hız açısından karşılaştırırım. saygılarımla

 

[06eed]

Rica ederim. İyi çalışmalar.