metin içerisinde düşeyara ile istenilen kelimeyi buldurma

kervansoft · 18 Ağustos 2015

Merhaba,
Elimde bir liste var bu listenin hücrelerinin içerisindeki cümlelerin içerisinde saha kodları bulunmakta bu saha kodlarını elimdeki saha kodu listesini kontrol ettirerek boş bir hücreye yazdırmak istiyorum.

"01/2015 ART-EDİZ 33ART193 KMT FAT. ÖD." hücrelerdeki metinler bu şekilde

elimdeki saha kodu listesi de
33ART193
23FTR192
41ANT051 gibi şimdi düşeyara gibi bir fonksiyon ile listedeki verileri cümle içerisinde sorgulatarak varsa cümle içerisindeki örneğin 33ART193'ü alıp boş bir hücreye yazdırmak istiyorum.

konu hakkında yardımlarınızı bekliyorum. İyi çalışmalar. Saygılar...

Korhan Ayhan · 18 Ağustos 2015

Boş bir sayfada;

A1 hücresine 33ART193 yazın.

"F" sütununda ise bahsettiğiniz uzun metinler olsun. ("01/2015 ART-EDİZ 33ART193 KMT FAT. ÖD.")

B1 hücresine aşağıdaki formülü uygulayın.

Kod:

=EĞERSAY(F:F;"*"&A1&"*")

kervansoft · 18 Ağustos 2015

ben bu uzun saha kodları listesinin olduğu listeyi kullanarak o metinin içerisindeki saha kodunu süzüp bir yere yazdırmak istiyorum. mesela saha kodu listesi 1 sayfada bu uzun metinler 2 sayfada birinci uzun metin hücresindeki saha kodunu sayfa birden kontrol edecek bulursa sayfa 2 deki hücrenin yanına metnin içersinde karşılaştırdığı saha kodunu mesela 33art193 ü yazacak. Bu şekilde yapmak istiyorum. Şimdiden teşekkürler

Korhan Ayhan · 18 Ağustos 2015

Örnek dosyanızı paylaşım sitelerine ekleyip linki foruma ekleyiniz.

Ayrıca dosyanız içinde görmek istediğiniz sonucu da lütfen belirtin.

excelokyanus500 · 18 Ağustos 2015

Deneyin

01/2015 ART-EDİZ 33ART193 KMT FAT. ÖD. =KelimeAl(A1;3;" ")

Fonksiyonu :

Function KelimeAl(HÜCRENİZ, KAÇINCIKELİME, Ayraç) As String

Dim Hücreseç As String, Boşluk As String
Dim ElemanSay As Integer, i As Integer

Hücreseç = HÜCRENİZ

If Ayraç = Chr(32) Then Hücreseç = Application.Trim(Hücreseç)

If Right(Hücreseç, 1) <> Ayraç Then Hücreseç = Hücreseç & Ayraç

ElemanSay = 0
Boşluk = ""

For i = 1 To Len(Hücreseç)
If Mid(Hücreseç, i, 1) = Ayraç Then
ElemanSay = ElemanSay + 1
If ElemanSay = KAÇINCIKELİME Then
'
KelimeAl = Boşluk
Exit Function
Else
Boşluk = ""
End If
Else
Boşluk = Boşluk & Mid(Hücreseç, i, 1)
End If
Next i
KelimeAl = ""
End Function

bzace · 18 Ağustos 2015

Merhabalar,
Formül ile alternatif;
Varsayımlar üzerinden gidelim.

A1:A5 aralığında listeniz,
B1:B3 aralığında saha kodlarınız,

girişlerini yaparak deneyiniz.

Kod:

=İNDİS(B$1:B$3;KAÇINCI(1;1-EHATA(MBUL(B$1:B$3;A1));))
[COLOR="Blue"]Formül dizi formülüdür.CTRL+SHIFT+ENTER ile tamamlayınız.[/COLOR]

kervansoft · 19 Ağustos 2015

Korhan Ayhan' Alıntı:
Örnek dosyanızı paylaşım sitelerine ekleyip linki foruma ekleyiniz.

Ayrıca dosyanız içinde görmek istediğiniz sonucu da lütfen belirtin.

dosyayı google drive ye yükledim yardımcı olursanız çok memnun olurum saygılarımla...

https://drive.google.com/file/d/0BzodIRRS_TfdTmd0aDNJS1ZiXzQ/view?usp=sharing

muygun · 19 Ağustos 2015

Merhaba;
Makro ile çözüm Alternatif olsun.
İnceleyin.
İyi çalışmalar.

Link:
http://s3.dosya.tc/server4/4budhr/kervansoft-icinde_bulursan_yaz.zip.html

Korhan Ayhan · 19 Ağustos 2015

#6 nolu mesajda önerilen formülü deneyiniz.

kervansoft · 19 Ağustos 2015

muygun' Alıntı:
Merhaba;
Makro ile çözüm Alternatif olsun.
İnceleyin.
İyi çalışmalar.

Link:
http://s3.dosya.tc/server4/4budhr/kervansoft-icinde_bulursan_yaz.zip.html

çok teşekkür ederim hocam işimi gördü. Elinize sağlık

AtillaB · 3 Eylül 2021

muygun' Alıntı:
Merhaba;
Makro ile çözüm Alternatif olsun.
İnceleyin.
İyi çalışmalar.

Link:
http://s3.dosya.tc/server4/4budhr/kervansoft-icinde_bulursan_yaz.zip.html

Merhaba,

Aynı problemi ben de yaşıyorum. Bu dosya işimi çözebilir belki ancak silinmiş. Tekrar destek olma şansınız var mı?

aliturkmen · 3 Eylül 2021

AtillaB' Alıntı:
Merhaba,

Aynı problemi ben de yaşıyorum. Bu dosya işimi çözebilir belki ancak silinmiş. Tekrar destek olma şansınız var mı?

downsoon · 23 Ocak 2023

Böyle bir makroya ihtiyacım var, yalnız ek olarak şuna ihtiyacım var.
1- D sütununda olanları A sütununda içeriyorsa (burada şu sıkıntı da var23 ü içeren 2 yi de içeriyor ama 23 ü almasını istiyorum) E sütununa yazması
2- F sütununda olanları A sütununda içeriyorsa G sütununa yazması.

Denedim ama makro bilgim az olduğu için uyarlayamadım, chatgpt üzerinden kodu güncellettim. Şu anda tam istediğim gibi çalışıyor.

Korhan Ayhan · 23 Ocak 2023

Umarım doğru anlamışımdır.

Deneyiniz.

C++:

Sub Bul_Listele()
    Dim X As Long, Y As Long, Search_Text As Integer
  
    Application.ScreenUpdating = False
  
    Range("E:E,G:G").ClearContents
  
    For X = 1 To Cells(Rows.Count, "A").End(3).Row
        If Cells(X, "A") <> "" Then
            For Y = 1 To Cells(Rows.Count, "D").End(3).Row
                If Cells(Y, "D") <> "" Then
                    If InStr(1, Cells(X, "A"), Cells(Y, "D")) > 0 Then
                        Cells(X, "E") = Cells(Y, "D")
                        Exit For
                    End If
                End If
            Next
      
            For Y = 1 To Cells(Rows.Count, "F").End(3).Row
                If Cells(Y, "F") <> "" Then
                    On Error Resume Next
                    Search_Text = 0
                    Search_Text = WorksheetFunction.Search(Cells(Y, "F"), Cells(X, "A"))
                    On Error GoTo 0
                    If Search_Text > 0 Then
                        Cells(X, "G") = Cells(Y, "F")
                        Exit For
                    End If
                End If
            Next
        End If
    Next

    Columns("A:G").AutoFit

    Application.ScreenUpdating = True
  
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

downsoon · 23 Ocak 2023

Alttaki kod sorunsuz çalışti. İlginize teşekkürler

Application.ScreenUpdating = False
On Error Resume Next
Sheets("Sayfa1").Range("E1:E65536").ClearContents
Set s1 = ThisWorkbook.Worksheets("Sayfa1")
sonsatir = s1.Range("A65536").End(xlUp).Row
sonsatir1 = s1.Range("b65536").End(xlUp).Row
For i = sonsatir To 1 Step -1
veri = UCase(Cells(i, 1))
For k = 1 To sonsatir1
If s1.Cells(k, 2) <> "" Then
bulunacak = InStr(1, veri, UCase(s1.Cells(k, 2)))
If bulunacak > 0 Then Cells(i, 3) = s1.Cells(k, 2)
End If
Next k
Next i
Application.ScreenUpdating = False
On Error Resume Next
Sheets("Sayfa1").Range("E1:E65536").ClearContents
Set s1 = ThisWorkbook.Worksheets("Sayfa1")
sonsatir = s1.Range("A65536").End(xlUp).Row
sonsatir1 = s1.Range("D65536").End(xlUp).Row
sonsatir2 = s1.Range("B65536").End(xlUp).Row
For i = sonsatir To 1 Step -1
veri = UCase(Cells(i, 1))
For k = 1 To sonsatir1
If s1.Cells(k, 4) <> "" Then
bulunacak = InStr(1, CStr(veri), UCase(CStr(s1.Cells(k, 4))))
If bulunacak > 0 Then Cells(i, 5) = s1.Cells(k, 4)
End If
Next k
For k = 1 To sonsatir2
If s1.Cells(k, 2) <> "" Then
bulunacak = InStr(1, veri, UCase(s1.Cells(k, 2)))
If bulunacak > 0 Then Cells(i, 3) = s1.Cells(k, 2)
End If
Next k
Next i
Application.ScreenUpdating = False
On Error Resume Next
Sheets("Sayfa1").Range("G1:G65536").ClearContents
Set s1 = ThisWorkbook.Worksheets("Sayfa1")
sonsatir = s1.Range("A65536").End(xlUp).Row
sonsatir1 = s1.Range("F65536").End(xlUp).Row
sonsatir2 = s1.Range("B65536").End(xlUp).Row
For i = sonsatir To 1 Step -1
veri = UCase(Cells(i, 1))
For k = 1 To sonsatir1
If s1.Cells(k, 6) <> "" Then
bulunacak = InStr(1, veri, UCase(s1.Cells(k, 6)))
If bulunacak > 0 Then Cells(i, 7) = s1.Cells(k, 6)
End If
Next k
For k = 1 To sonsatir2
If s1.Cells(k, 2) <> "" Then
bulunacak = InStr(1, veri, UCase(s1.Cells(k, 2)))
If bulunacak > 0 Then Cells(i, 3) = s1.Cells(k, 2)
End If
Next k
Next i
End Sub

downsoon · 23 Ocak 2023

Tek sıkıntısı Türkçe karakterlerde sorun çıkarıyor. Örneğin Mahkeme ile MAHKEME yi aynı diyor buluyor ama Vergi ile VERGİ yi eşleştiremiyor. Yani Türkçe karakterin büyük küçük harf olması formülü bozuyor

Korhan Ayhan · 23 Ocak 2023

Bu yorumunuz hangi kod içindi?

downsoon · 24 Ocak 2023

Korhan Ayhan' Alıntı:
Bu yorumunuz hangi kod içindi?

Bir üstte yazdığım kodla ilgili. Sizin kodu çalıştıramadım açıkçası. A sütunundaki verileri G sütununa yapıştırdı uyguladığımda

Korhan Ayhan · 24 Ocak 2023

Ben önerdiğim kodu güncelledim. Tekrar deneyiniz.

downsoon · 24 Ocak 2023

Süper, elinize sağlık. Sizin kod bendekinden çok daha hızlı çalıştı.

Sadece aynı sıkıntı devam ediyor. Türkçe karakter büyük küçük harf duyarlılığı var

metin içerisinde düşeyara ile istenilen kelimeyi buldurma

kervansoft

Korhan Ayhan

Administrator

kervansoft

Korhan Ayhan

Administrator

excelokyanus500

bzace

kervansoft

muygun

Özel Üye

Ekli dosyalar

Korhan Ayhan

Administrator

kervansoft

AtillaB

aliturkmen

Ekli dosyalar

downsoon

Ekli dosyalar

Korhan Ayhan

Administrator

downsoon

downsoon

Korhan Ayhan

Administrator

downsoon

Korhan Ayhan

Administrator

downsoon