Cumle icinde gecen il isimlerini buldurmak

[kneehot]

Arkadaslar merhaba. Yapmaya calıstıgım uzun bır lıstem var ve her satırda yazan cumlenın ıcınde bır ıl ısmı yazıyor. cumle ıcınde gecen ıl ısmını yan sutununa yazdırmak ıstıyorum. yardımlara sımdıden cok tesekkur ederım.

 

[kneehot]

bu arada ornek dosya ekleyecektim ama nasıl oldugunu bulamadım.

 

[Erdem Akdemir]

Merhaba,

http://www.dosyaupload.com/ adresine dosyanızı yükleyerek indirme linkini burada paylaşabilirsiniz.
Site üzerinden dosya yüklemeyi sadece Altın üyeler yapabilir.

 

[Asri]

Sayfa1 de A1 den aşağı doğru şehir isimlerini yazın
ANKARA
DİYARBAKIR
İSTANBUL
İZMİR

Sayfa2 de A1 den aşağı doğru adres bilgilerini yazın
aa123456istanbul789
bb123ankara4567

Sonuç,
aa123456789 İSTANBUL
bb1234567 ANKARA



Program B kolonuna şehir isimlerini yazacaktır.
Adresde birkaç şehir var ise (olmaz ama) ilk bulduğunu yazar.

Bu mantıkla, aşağıdaki gibi bir adres olur ise yanlış sonuç verecektir.
İstanbul yolu 3. km BURSA

Sub MENU()
  Call kontrol
End Sub

Public Function buyukharf(cumle)
gecici = ""
For i = 1 To Len(cumle)
          h = Mid(cumle, i, 1)
          Select Case h
            Case "ğ": gecici = gecici + "Ğ"
            Case "ü": gecici = gecici + "Ü"
            Case "ş": gecici = gecici + "Ş"
            Case "ç": gecici = gecici + "Ç"
            Case "ö": gecici = gecici + "Ö"
            Case "ı": gecici = gecici + "I"
            Case "i": gecici = gecici + "İ"
            Case Else: gecici = gecici + UCase(h)
            End Select
Next i
buyukharf = gecici
End Function

Sub kontrol()
  Application.ScreenUpdating = False
  Sheets("Sayfa2").Select
  sonsatiradres = Cells(Rows.Count, "A").End(3).Row
  
  Columns("B:B").Select
  Selection.ClearContents
  Range("B1").Select
  
  Sheets("Sayfa1").Select
  sonsatiril = Cells(Rows.Count, "A").End(3).Row
  
  For i = 1 To sonsatiril
    Sheets("Sayfa1").Select
    sehir = buyukharf(Cells(i, 1).Value)
    
    For j = 1 To sonsatiradres
      Sheets("Sayfa2").Select
      adres = buyukharf(Cells(j, 1).Value)
      adresorg = Cells(j, 1).Value
      If InStr(adres, sehir) > 0 Then
         basla = InStr(adres, sehir)
         Cells(j, 2).Value = Mid(adres, basla, Len(sehir))
         'Bu bölüm adresten şehir i çıkarır.
          Cells(j, 1).Value = Left(adresorg, basla - 1) & Mid(adresorg, basla + Len(sehir), Len(adresorg))
      End If
    Next j
    
  Next i
  
  Application.ScreenUpdating = False

  
End Sub

 

[kneehot]

Sayfa1 de A1 den aşağı doğru şehir isimlerini yazın
ANKARA
DİYARBAKIR
İSTANBUL
İZMİR

Sayfa2 de A1 den aşağı doğru adres bilgilerini yazın
kajs kljsd klsaj lkj lkj s lİSTANBUL ddfsfds
hkljkljlkjkljlkankarakkjkjkjkj
jfljdfljsdkfbkbkjdiyarbakırıjjoıop

Program B kolonuna şehir isimlerini yazacaktır.
Adresde birkaç şehir var ise (olmaz ama) ilk bulduğunu yazar.

Bu mantıkla, aşağıdaki gibi bir adres olur ise yanlış sonuç verecektir.
İstanbul yolu 3. km BURSA

Sub MENU()
  Call kontrol
End Sub

Public Function buyukharf(cumle)
gecici = ""
For i = 1 To Len(cumle)
          h = Mid(cumle, i, 1)
          Select Case h
            Case "ğ": gecici = gecici + "Ğ"
            Case "ü": gecici = gecici + "Ü"
            Case "ş": gecici = gecici + "Ş"
            Case "ç": gecici = gecici + "Ç"
            Case "ö": gecici = gecici + "Ö"
            Case "ı": gecici = gecici + "I"
            Case "i": gecici = gecici + "İ"
            Case Else: gecici = gecici + UCase(h)
            End Select
Next i
buyukharf = gecici
End Function

Sub kontrol()
  Application.ScreenUpdating = False
  Sheets("Sayfa2").Select
  sonsatiradres = Cells(Rows.Count, "A").End(3).Row
  
  Columns("B:B").Select
  Selection.ClearContents
  Range("B1").Select
  
  Sheets("Sayfa1").Select
  sonsatiril = Cells(Rows.Count, "A").End(3).Row
  
  For i = 1 To sonsatiril
    Sheets("Sayfa1").Select
    sehir = buyukharf(Cells(i, 1).Value)
    
    For j = 1 To sonsatiradres
      Sheets("Sayfa2").Select
      adres = buyukharf(Cells(j, 1).Value)
      If InStr(adres, sehir) > 0 Then
         Cells(j, 2).Value = Mid(adres, InStr(adres, sehir), Len(sehir))
         Exit For
      End If
    Next j
    
  Next i
  
  Application.ScreenUpdating = False

  
End Sub

cok tesekkur ederım.

 

[hayaletinizi]

Bu konuya benzer sorular sordum bu sitede ve eger dosya ekleyebilirseniz formul ile de cozumu mumkun. Saygilar

 

[mrwarrior]

http://www.dosyaupload.com/1jsv

Cümle içind geçen alfabetik olarak ilk 6 ili veriri.

 

[tahsinanarat]

Sn. asri, Sayfa2 deki a sütununda bulunan adreslerde aynı şehir ismi olan cümlelerden saadece birini ayırıyor, diğerlerini ayırmıyor,
ayrıca; şehir isimlerini b sütununa yazdıktan sonra cümle içinden nasıl sildirebiliriz. Teşekkürler

 

[Asri]

Sn. asri, Sayfa2 deki a sütununda bulunan adreslerde aynı şehir ismi olan cümlelerden saadece birini ayırıyor, diğerlerini ayırmıyor,
ayrıca; şehir isimlerini b sütununa yazdıktan sonra cümle içinden nasıl sildirebiliriz. Teşekkürler

4. mesajdaki kod istediğiniz şekilde güncellendi.

 

[tahsinanarat]

Sn. asri bey, tam istediğim gibi olmuş, umarım çok kişi bundan faydalanacaktır. Elinize sağlık