cumlem = Split(Target.Value, "/") kodunda kriter sayısını artırmak

hsayar · 11 Ocak 2008

hücre içeriğimiz
ARİFPAŞA CaddesiAYNALI SÜPÜRGE SokağıBALIKPAZARI CaddesiBUZHANE SokağıBUZHANE ARKA SokağıBÜYÜK YANGINLIK SokağıCUMHURİYET CaddesiDARÜLHADİS CaddesiDOĞAN SokağıFERHAT AĞA SokağıFIRIN SokağıGAZİPAŞA CaddesiHALABİYE MEDRESE SokağıKANBER BABA TEKKE SokağıKEÇECİLER SokağıKISA ÇUKUR SokağıKULÜP SokağıKÜÇÜK CAMİİ SokağıKÜÇÜK MANYAS SokağıKÜÇÜK YANGINLIK SokağıMAARİF CaddesiMANYAS CaddesiMANYAS KARAKOL SokağıMANYAS KARAKOL ALTI SokağıMANYAS ÇUKUR ÇIKMAZ SokağıMERİÇ SokağıMUSTAFA EFENDİ SokağıNECİP KOSKATI SokağıNİĞBOLU SokağıORTA SokağıOSMAN BEY SokağıOSMAN KORAL SokağıOSMAN NURİ PEREMECİ SokağıOSMANİYE CaddesiSARAÇLAR CaddesiSEDDE YOLU SokağıSÖĞÜTLÜK SokağıSİNEMA ARALIĞI SokağıSİNEMA ARKA SokağıSİNEMA KARŞI SokağıTABAKHANE SokağıTEKKE KARŞI SokağıTOPKAPI CaddesiTUNCA SokağıTÜFEKÇİLER SokağıTÜRKOCAĞI SokağıZİNDAN SokağıZİNDANALTI SokağıÇUKUR SokağıİNÖNÜ CaddesiİZMİR Caddesi
olsun

cumledeki_csbmb = Split(Target.Value, "/") kodunda / yerine
ne yazmalıyım ki Caddesi,Sokağı,Kümesi,Meydanı,Bulvarı gibi kelimeler ayrı ayrı diziye alınmış olsun
aşağıdaki olaydada göürleceği üzere satırlara dönüştürülsün;

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [I1:I65536]) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub

   sonsat&#305;r = [Q65536].End(3).Row + 1

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

kod çalıştıktan sonra hücrelerde gözükecek göürünüm aşağıdaki şekildedir.
ARİFPAŞA Caddesi
AYNALI SÜPÜRGE Sokağı
BALIKPAZARI Caddesi
BUZHANE Sokağı
BUZHANE ARKA Sokağı
teşekkürler

hamitcan · 11 Ocak 2008

Aşağıdaki kodu dener misiniz?

Kod:

Sub AYIR()
    [a2] = Replace([a1], "Caddesi", "Caddesi*")
    [a2] = Replace([a2], "Sokağı", "Sokağı*")
    cumledeki_degerler = Split([a2], "*")
    For i = 0 To UBound(cumledeki_degerler)
        c = c + 1
        Cells(c, 3) = cumledeki_degerler(i)
    Next
End Sub

hsayar · 11 Ocak 2008

hocam kodlar istediğim gibi ancak tek bir satırdan bahsetmediğim için kifayetsiz kalıyor

ben size örnek dosya gönderiyorum. şimdi
ve takrar anlatayım önce tam anlatamamışım

Caddesi
Sokağı
Kümesi
Meydanı
Bulvarı
Kelimeleri Ayrılacak
Uzunluk Px 5000 leri bile geçebilir
p2(sonsatır) aralığı ayırma işlemine tabi olacak
Ayrılanlar z2 den itiabren listelenecek
j aralığındaki sütunlar sokağın kopyalandığı satırın t:y sütunlarına kopyalanacak
p3 e gelindiğinde z sütunundaki ilk boş satırdan itibaren işlem devam edecek

Şu anda önce P Sütununu worda atıp, aşağıdaki makrou çalıştıroyorum

Kod:

Sub Makro1()
'
' Makro1 Makro
' Makro, CASPER tarafından 11.01.2008 tarihinde kaydedildi
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "Sokağı"
        .Replacement.Text = "Sokağı/"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveWindow.ActivePane.VerticalPercentScrolled = 9
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
'00000000000000000000000000000000000000000000000000
    With Selection.Find
        .Text = "Caddesi"
        .Replacement.Text = "Caddesi/"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveWindow.ActivePane.VerticalPercentScrolled = 9
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
'00000000000000000000000000000000000000000000000000
    With Selection.Find
        .Text = "Kümesi"
        .Replacement.Text = "Kümesi/"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveWindow.ActivePane.VerticalPercentScrolled = 9
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
'00000000000000000000000000000000000000000000000000
    With Selection.Find
        .Text = "Meydanı"
        .Replacement.Text = "Meydanı/"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveWindow.ActivePane.VerticalPercentScrolled = 9
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
'00000000000000000000000000000000000000000000000000
    With Selection.Find
        .Text = "Bulvarı"
        .Replacement.Text = "Bulvarı/"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveWindow.ActivePane.VerticalPercentScrolled = 9
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
End Sub

sonra worddeki tek sütunlu tabloyu excele kopyalayıp

Kod:

Sub temp_sokak()
sonsatır = [P65536].End(3).Row
For i = 2 To sonsatır
    If Cells(i, "P") <> "" Then
        Cells(i, "R") = LTrim(Cells(i, "P"))
    End If
Next i
MsgBox "bitti"
End Sub

makrosunu çalıştırıyorum.

Ardından sayfada olan

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [H2:H65536,r2:r65536]) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub

If Target.Column = 8 Then
MsgBox "Mahalleler Dağıtılacaktır"

   sonsatır = [O65536].End(3).Row + 1
    'MsgBox sonsatır
    cumledeki_degerler = Split(Target.Value, "/")
    For i = 0 To UBound(cumledeki_degerler)
        Cells(sonsatır + i, "J") = Cells(Target.Row, "A")
        Cells(sonsatır + i, "K") = Cells(Target.Row, "B")
        Cells(sonsatır + i, "L") = Cells(Target.Row, "C")
        Cells(sonsatır + i, "M") = Cells(Target.Row, "D")
        Cells(sonsatır + i, "N") = Cells(Target.Row, "E")
        Cells(sonsatır + i, "O") = cumledeki_degerler(i)
    Next
'End If
    
'18
ElseIf Target.Column = 18 Then
'MsgBox "Sokaklar Dağıtılacaktır"
   sonsatır = [Z65536].End(3).Row + 1
    'MsgBox sonsatır
    cumledeki_degerler = Split(Target.Value, "/")
    For i = 0 To UBound(cumledeki_degerler)
        Cells(sonsatır + i, "T") = Cells(Target.Row, "J")
        Cells(sonsatır + i, "U") = Cells(Target.Row, "K")
        Cells(sonsatır + i, "V") = Cells(Target.Row, "L")
        Cells(sonsatır + i, "W") = Cells(Target.Row, "M")
        Cells(sonsatır + i, "X") = Cells(Target.Row, "N")
        Cells(sonsatır + i, "Y") = Cells(Target.Row, "O")
        Cells(sonsatır + i, "Z") = cumledeki_degerler(i)

    Next
End If

makrosu devraya giriyor ve sonuca ulaşıyorum anacak bu işlem epey uzun sürüyor.

hamitcan · 11 Ocak 2008

Size önerim, verdiğim koddan da yararlanarak ayıracağınız cümleleri ortak bir paydada toplamanız. Kısaca ayıracağınız kelimelerin sonuna bir ayıraç koyabilirsiniz. Örn:"*" gibi.

Daha sonra bir döngü oluşturup hepsini ayrı hücrelere aktarmanız mümkün olabilir.

hsayar · 11 Ocak 2008

hocam ben dendim ama beceremedim
o zaman şöyle bir şey istesim sizden

A2: A1 CaddesiB1 sokakC1 Kümesi
A3: A2 CaddesiB2 sokakC2 Kümesi

şeklini b sütununa
B2: A1 Caddesi
B3: B1 sokak
B4: C1 Kümesi
B5: A2 Caddesi
B6: B2 sokak
B7: C2 Kümesi

şeklinde dağıtabileceğim basit bir örnek rica edebilirmiyim

hamitcan · 11 Ocak 2008

Aşağıdaki şekilde dener misiniz?

Kod:

Sub AYIR()
    [a2] = Replace([a1], "Caddesi", "Caddesi*")
    [a2] = Replace([a2], "Sokağı", "Sokağı*")
    [a2] = Replace([a2], "Kümesi", "Kümesi*")
    
    cumledeki_degerler = Split([a2], "*")
    For i = 0 To UBound(cumledeki_degerler)
        c = c + 1
        Cells(c, 3) = cumledeki_degerler(i)
    Next
End Sub

hsayar · 11 Ocak 2008

olmuyor hocam
girirlenler
A1: cümle
A2: A1 CaddesiB1 sokakC1 Kümesi
A3: A2 CaddesiB2 sokakC2 Kümesi

makrodan sonra dönen
A1:cümle |B1:BOŞ |C1:cümle
A2:cümle
A3:A2 CaddesiB2 sokakC2 Kümesi

hsayar · 11 Ocak 2008

Sonunda hallettim herhalde

Kod:

Sub AYIR4()
    sonsatirknt = [B65536].End(3).Row
    For knt = 2 To sonsatirknt
        Cells(knt, "B").Value = LTrim(Cells(knt, "B").Value)
        Cells(knt, "B").Value = RTrim(Cells(knt, "B").Value)
        Cells(knt, "B").Value = Replace(Cells(knt, "B").Value, "Caddesi", "Caddesi*")
        Cells(knt, "B").Value = Replace(Cells(knt, "B").Value, "Soka&#287;&#305;", "Soka&#287;&#305;*")
        Cells(knt, "B").Value = Replace(Cells(knt, "B").Value, "K&#252;mesi", "K&#252;mesi*")
        Cells(knt, "B").Value = Replace(Cells(knt, "B").Value, "Meydan&#305;", "Meydan&#305;*")
        Cells(knt, "B").Value = Replace(Cells(knt, "B").Value, "Bulvar&#305;", "Bulvar&#305;*")
        If Right(Cells(knt, "B").Value, 1) = "*" Then
            Cells(knt, "B").Value = Left(Cells(knt, "B").Value, (Len(Cells(knt, "B").Value) - 1))
        End If
        
        cumledeki_degerler = Split(Cells(knt, "B").Value, "*")
            For i = 0 To UBound(cumledeki_degerler)
                sonsatirYaz = [D65536].End(3).Row + 1
                Cells(sonsatirYaz, "C") = Cells(knt, "A")
                Cells(sonsatirYaz, "D") = cumledeki_degerler(i)
            Next i
    Next knt
End Sub

cumlem = Split(Target.Value, "/") kodunda kriter sayısını artırmak

hsayar

hamitcan

Uzman

hsayar

hamitcan

Uzman

hsayar

hamitcan

Uzman

hsayar

hsayar