satırdakı belırlı aralıgı cıkarma

[qwerty1478]

merhaba arkadaslar
asagıdakı ornektekı "Adresi: Ankara Tel: +90-5311223311" kısımını toplu olarak nasıl satırlardan cıkartabilirim. son kısım degisken


Ahmet ATA : erkek, 1970 doğumlu, 170boy , Adresi: Ankara Tel: +90-5311223311 , serbest

 

[Haluk]

Bu tür sorunlarda daha fazla örneğe ihtiyaç duyulur ki, en doğru çözüm üretilebilsin....

Çok daha fazla örneğin olduğu bir dosya ekleyin, bence....

Bütün veriler bu şekilde "," ile ayrılmış mı, "Adresi:" kelimesi tüm verilerde var mı, ":" işareti tüm verilerde var mı ..... gibi bilgilere ihtiyaç duyulacaktır.

.

 

[qwerty1478]

Bu tür sorunlarda daha fazla örneğe ihtiyaç duyulur ki, en doğru çözüm üretilebilsin....

Çok daha fazla örneğin olduğu bir dosya ekleyin, bence....

Bütün veriler bu şekilde "," ile ayrılmış mı, "Adresi:" kelimesi tüm verilerde var mı, ":" işareti tüm verilerde var mı ..... gibi bilgilere ihtiyaç duyulacaktır.

.

evet hocam tum veriler standart kalıpta benım cıkmasını ıstedıgım bolumde her satırda"Adresi:" kelimesi ile baslıyor fakat uzunlukları ve sonlanması farklı , en son kısımdaki"serbest" kelımesi de cogunlukla farklı

 

[Haluk]

Verilerin A sütununda olduğunu düşünerek, VBA ile bir çözüm;

7 No'lu mesaja bakınız...

.

 

[çıtır]

Formül ile Verilerinizin A1 Hücresinden başladığı kabul edilmişdir.B1 Hücresine kopyalayınız.Aşağı doğru çoğaltınız.

=PARÇAAL($A1;MBUL("Adresi:";$A1);MBUL("+??-??????????";$A1)+14-MBUL("Adresi:";$A1))

 

[qwerty1478]

Verilerin A sütununda olduğunu düşünerek, VBA ile bir çözüm;

Sub Test()
'   Haluk - 31/08/2019
'   sa4truss@gmail.com
    Dim NoA As Long
    Dim regExp As Object, objMatches As Object
    Dim myStr As String, i As Long, j As Byte, jj As Byte
  
    NoA = Range("A" & Rows.Count).End(xlUp).Row
    Range("B2:B" & NoA) = ""
  
    Set regExp = CreateObject("VBScript.RegExp")
  
    regExp.IgnoreCase = True
    regExp.Global = True
    regExp.Pattern = "Adresi:(.+)\,"
  
    For i = 2 To NoA
        myStr = Range("A" & i)
        If regExp.Test(myStr) Then
            Set objMatches = regExp.Execute(myStr)
            Cells(i, 2) = Replace(Replace(Cells(i, 1), objMatches.Item(j).Submatches(0), ""), "Adresi:,", "")
        End If
    Next
  
    Set regExp = Nothing
    Set objMatches = Nothing
End Sub

.

çok tesekur ederim hocam istedigim gibi oldu buna baska 2.bir kosul ekleyebilirmiyiz. mesala adresi yerine ikameti yazarsa onuda silebilirmi aynı işlemde.

 

[Haluk]

İşin en başında bunu demek istemiştim ..... siz de standart kalıp demiştiniz, ama öyle değil galiba ....

Adres/İkamet olasılığına göre;

Sub Test2()
'   Haluk - 31/08/2019
'   sa4truss@gmail.com
    Dim NoA As Long
    Dim regExp As Object
    Dim myStr As String, i As Long
   
    NoA = Range("A" & Rows.Count).End(xlUp).Row
    Range("B2:B" & NoA) = ""
   
    Set regExp = CreateObject("VBScript.RegExp")
   
    regExp.IgnoreCase = True
    regExp.Global = True
    regExp.Pattern = "(Adresi|İkameti):(.+)\,"
   
    For i = 2 To NoA
        myStr = Range("A" & i)
        If regExp.Test(myStr) Then
            Range("B" & i) = regExp.Replace(myStr, "")
        End If
    Next
   
    Set regExp = Nothing
End Sub

.

 

[qwerty1478]

cok az farklı kelımeler var onları bul degistir yapmayı dusunmustum ama bu sekılde daha isime yarayacak cok tesekur ederim.

 

[Haluk]

7 No'lu mesajdaki kodu güncelledim, onunla daha rahat edersiniz...

.

 

[qwerty1478]

7 No'lu mesajdaki kodu güncelledim, onunla daha rahat edersiniz...

Ahmet ATA : erkek, 1970 doğumlu, 170boy , Adresi: Ankara mamak Tel: +90-5311223311 , serbest

mehmet genç: erkek, 1980 doğumlu,185boy , Adresi: Ankara sincan Tel: +90-5311224422 , mimar , lisans , evli

ayse genç: bayan , 1985 doğumlu,173boy , ikameti :: Ankara  çankaya Tel: +90-5311225533 , ogrenci , lise

hocam istedigim gibi oldu ama son kısımlarda arada hata olusuyor son kısım degisken ve bazı aralarda yıne virgul kulanılmıs
arada kalan Adresi: Ankara çankaya Tel: +90-5311225533 kısmını cıkartıp son bolumlerın hepsini yazdırabilirmiyiz.



.

 

[qwerty1478]

cıkarılacak bolum Adresi: ile baslayıp telefon numarası ile sonlanıyo sanırsam bazıları bos atıyor . eger telefon yazılı degilse nasıl bir işlem yapılabilir.
size cok zahmet verdım hocam ilginize çok tesekur ederim.

 

[Haluk]

Daha önce dediğim gibi, bu tip sorunlarda mümkün mertebe fazla sayıda örneğe ihtiyaç duyulur ki, en doğru çözüm üretilebilsin.

Örnek bir dosya eklemediğiniz için bu yüzden devamlı revizyon ihtiyacı duyuyorsunuz...

.

 

[qwerty1478]

hocam ozel bilgiler oldugu ıcın ekleyemedim duzenleme yapıp orneklerı cogaltıp eklesem bakabilirmisiniz. birde dosya ekleyemiyorum link eklesem sıkıntı olurmu.

 

[Haluk]

Bu iş için bir ücret ödemeyi düşünüyor musunuz?

.

 

[Haluk]

Sorunuzun "ücretsiz" olarak klasik formüllerle çözümü;

Türkçe Excel için:

=SOLDAN(A2;BUL("~";YERİNEKOY(A2;",";"~";3))-1) & PARÇAAL(A2;BUL("~";YERİNEKOY(A2;",";"~";4));255)

İngilizce Excel için:

=LEFT(A2;FIND("~";SUBSTITUTE(A2;",";"~";3))-1) & MID(A2;FIND("~";SUBSTITUTE(A2;",";"~";4));255)

Not: Veriler çok fazla sayıdaysa "ücretli" VBA çözümünü öneririm (2 adet alternatifli)

.

 

[qwerty1478]

formuller le istedigim gibi oldu yapmak istedigim işlem genelde 2 satır ile 6 satır arası gunde 7-8 işlem gerekiyor çok tesekurler yardımlarınız için