Adres Ayrıştırma

[pablo_76]

Arkadaşlar herkese merhabalar;

bana yardımcı olabilecek arkadaşların olabileceği düşüncesi ile yazıyorum.Adres ayırma gibi ciddi bir zaman kaybına neden olan bir işlevimiz var.Benim istediğim özellikler şöyle umarım yardımlarınızı esirgemezsiniz.Elimizde ham bir adres datası var ve bunu bölge bölge ayırmamız gerekiyor mesela 1.bölge için x semt 2.bölge için x semt bu böyle 3 4 5 6 diye gidiyor.Benim sormak istediğim böyle bir program excelde mümkünmü mesela ben programa 1.bölge için geçerli olacak semt veya şehirleri tanımlayacağım bu 2.ve diğer bölgeler içinde geçerli olacak.Excel datasını programa aktardığımda bu ayrımın 1.2.3 ve diğer bölgelere bölünmüş halde gerçekleşmesi lazım.(bir nevi tüm adres içerisinde kelime tanıyacak.İnanıyorum ki excel'i bilen arkadaşlar için çok basit bir konu ama ne yapayım bilmiyorum işte Yardımı olacak ve yardım etmeyi düşünen arkadaşlara sonsuz teşekkürlerimi şimdiden sunuyorum.

 

[Ferhat Pazarçevirdi]

Merhabalar

Sorunuzu örnek bir dosya ile destekler misiniz?

 

[Ercan_ÇELİKOĞLU]

Arkadaş adres ayırma istiyor

Merhabalar

Sorunuzu örnek bir dosya ile destekler misiniz?

yani şöyle üstadım

1.sayfa adresler datası olacak 2.sayfa ve diğer sayfalar açılan kutu seçilen adrese bağlanıcak bu şekilde bir ulaşım isteniyor anladığım kadarıyla; yine karıştım ama yani bul makrosu . ve aktar makroları olacak benim anladığım kadarı ile

 

[Ercan_ÇELİKOĞLU]

yani şöyle bişeymi?

Arkadaşım sorduğunuz soruya göre örnek bir tablo hazırladım bir inceleyin ve isteklerinizi o tablo üzerinde yazarak daha net belirtin.

 

[pablo_76]

Öncelikle ilgilendiğiniz için teşekkür ederim.Arkadaşlar örnek aşağıda elimden geldiğince açıklayıcı olmaya çalıştım.Umarım anlatabilmişimdir.

 

[pablo_76]

kimse yardımcı olamıyormu arkadaşlar.

 

[Ferhat Pazarçevirdi]

Merhabalar

Aşağıdakileri standart bir modül sayfasına kopyalayanız veya örnek dosyayı inceleyiniz.

Option Explicit
Sub Adres_Ayristir()
Dim shA As Worksheet, shS As Worksheet, shR As Worksheet
Dim bul As Range
Dim i&, y&
Dim adres As String
Set shA = Sheets("İŞLENECEK MÜŞTERİ ANA DATASI")
Set shS = Sheets("SEMT VERİTABANI")
For i = 1 To shS.Cells(65536, 1).End(xlUp).Row
    Set bul = shA.Columns(2).Find(shS.Cells(i, 1))
    If Not bul Is Nothing Then
       adres = bul.Address
       On Error Resume Next
       Set shR = Sheets(shS.Cells(i, 1).Text)
       shR.Cells.ClearContents
       If Err.Number <> 0 Then
          Set shR = Sheets.Add(, Sheets(Sheets.Count))
          shR.Name = shS.Cells(i, 1)
          Err.Number = 0
       End If
       Do
          y = y + 1
          shR.Cells(y, 1) = bul.Offset(0, -1)
          shR.Cells(y, 2) = bul
          Set bul = shA.Columns(2).FindNext(bul)
       Loop While Not bul Is Nothing And bul.Address <> adres
       Set shR = Nothing
    End If
    y = 0
Next i
MsgBox "Bölgelere ayırma işlemi tamamlandı. Sayfaları kontrol ediniz.", vbInformation, "TAMAMLANDI..."
Set shA = Nothing
Set shS = Nothing
End Sub

 

[pablo_76]

merhaba çalışmanız için teşekkür ederim sanırım bu işi gelişrmenizi isteyeceğim biraz tabii zamanınız uyunsa.size msnden ulaşabilirmiyim?