• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Hücre içinde kelime istenilen kelimeyi bulma

  • Konbuyu başlatan Konbuyu başlatan besen
  • Başlangıç tarihi Başlangıç tarihi

besen

Altın Üye
Katılım
23 Mart 2007
Mesajlar
822
Excel Vers. ve Dili
Microsoft Office LTSC Professional Plus 2021
İngilizce
Merhaba hücrelerde aşağıdaki şekilde bilgiler var.


Turizm ve Otel İşletmeciliği (Tam Burslu)
Turizm ve Otel İşletmeciliği (%50 Burslu)
Turizm ve Otel İşletmeciliği (%25 Burslu)
Bilgisayar Programcılığı (Tam Burslu)
Bilgisayar Programcılığı (%50 Burslu)
Bilgisayar Programcılığı (%25 Burslu)

benim istediğim bu bilgilerin olduğu hücrenin yanına otomatik olarak sırayla
(Tam Burslu)
(%50 Burslu)
(%25 Burslu)
(Tam Burslu)
(%50 Burslu)
(%25 Burslu)

gelsin.

teşekkürler.
 
Merhaba,

Kodları kendinize göre düzenleyiniz.

Kod:
Sub Ayir()
    
    Dim i As Long
    
    On Error Resume Next
    
    Application.ScreenUpdating = False
    
    For i = 2 To Cells(Rows.Count, "a").End(3).Row
        Cells(i, "B") = Split(Cells(i, "A"), "(")(1)
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "İşem Tamam"
    
End Sub
 

Ekli dosyalar

Merhaba,

Veriniz A1 hücresinde olduğunu varsayalım.
Kod:
=EĞER(EHATALIYSA(PARÇAAL(A1;BUL("(";A1)+1;BUL(")";A1)-BUL("(";A1)-1));"";PARÇAAL(A1;BUL("(";A1)+1;BUL(")";A1)-BUL("(";A1)-1))
 
Teşekkürler, formülü ingilizce olarak yazabilirmisiniz
 
Merhaba teşekkürler.
sanırım siz parantezlere göre ayırtmışsınız. ancak her zaman parantez olmayabilir.
mesela bu örnekte, istenilen tam burslu ve %50 burslu iken, "uzaktan eğitim)" şeklinde ayırım yapıyor.

Çocuk Gelişimi (Uzaktan Eğitim) (Adana) (Tam Burslu)--- Uzaktan Eğitim)
Çocuk Gelişimi (Uzaktan Eğitim) (Adana) (%50 Burslu)--- Uzaktan Eğitim)
 
Merhaba teşekkürler.
sanırım siz parantezlere göre ayırtmışsınız. ancak her zaman parantez olmayabilir.
mesela bu örnekte, istenilen tam burslu ve %50 burslu iken, "uzaktan eğitim)" şeklinde ayırım yapıyor.

Çocuk Gelişimi (Uzaktan Eğitim) (Adana) (Tam Burslu)--- Uzaktan Eğitim)
Çocuk Gelişimi (Uzaktan Eğitim) (Adana) (%50 Burslu)--- Uzaktan Eğitim)
Sorunuzu sorarken bu ayrıntılardan bahsetmediniz.
 
eksiklikten dolayı özür dilerim
 
Merhaba teşekkürler.
sanırım siz parantezlere göre ayırtmışsınız. ancak her zaman parantez olmayabilir.
mesela bu örnekte, istenilen tam burslu ve %50 burslu iken, "uzaktan eğitim)" şeklinde ayırım yapıyor.

Çocuk Gelişimi (Uzaktan Eğitim) (Adana) (Tam Burslu)--- Uzaktan Eğitim)
Çocuk Gelişimi (Uzaktan Eğitim) (Adana) (%50 Burslu)--- Uzaktan Eğitim)

Boş durma boşa çalışın diyorsunuz yani.

Bir Tüm olasılıkları neden söylemezsiniz ki baştan?
İki konuyu makro bölümünde açmışsınız sonrada formülün ingilizcesini istiyorsunuz, yani fonksiyon size yetiyor.
 
Hocam fonksiyonla çözüleceğini bilemediğim için makro kısmına yazdım, sonuçta biz talepkarız.
kusurlarımız hoşgörüle.
 
Kaç çeşit burs türü var?
(Tam Burslu)
(%50 Burslu)
(%25 Burslu)
hepsi bu mudur?

Formülü, makroya altarnatif yazmıştım aslında.
 
bir de (%75 Burslu) var ama, daha genel bir çözüm olabilir mi, örneğin arama yapılacak keline veya kelimeleri başka bir yere alt alta yazsak, makro ordan okusa .
teşekkür
 
Açıkcası dosyanızın daha farklı olduğu kanısındayım.
Lokal bir çözüm isterseniz formülü deneyiniz.
Kod:
=EĞER(EĞERSAY(A1;"*Tam Burslu*")=1;"Tam Burslu";EĞER(EĞERSAY(A1;"*%75 Burslu*")=1;"%75 Burslu";EĞER(EĞERSAY(A1;"*%50 Burslu*")=1;"%50 Burslu";EĞER(EĞERSAY(A1;"*%25 Burslu*")=1;"%25 Burslu";""))))
 
Tamam herkese teşekkürler, istediğim buydu.

sevgi, saygı
 
:roll::roll::roll:
İyi çalışmalar.
 
Merhaba,

Aşağıdaki kodları da deneyiniz.

Kod:
Sub Ayir()
    
    Dim i As Long
    Dim j As Integer
    
    Dim a
    
    On Error Resume Next
    
    Application.ScreenUpdating = False
    
    For i = 2 To Cells(Rows.Count, "a").End(3).Row
        a = Split(Cells(i, "A"), "(")
        For j = 0 To UBound(a)
            If a(j) Like "*ursl*" Then
                Cells(i, "B") = Replace(a(j), ")", "")
                Exit For
            End If
        Next j
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "İşlem Tamam", vbInformation
    
End Sub
 

Ekli dosyalar

Geri
Üst