HÜCRE İÇİNDE VARSA

[polis-53]

Merhaba arkadaşlar ekte gönderdiğim dosyada A kolonunda isimler var H kolonunda da isimler var benim istediğim H kolonunda ki isim A kolonunun içinde varsa B kolonuna H kolonundaki ismi yazsın yardım ederseniz çok sevinirim

 

[walabi]

İnceleyin.

 

[polis-53]

İnceleyin.

çok teşekkür ederim, kal sağlıcakla.

 

[walabi]

çok teşekkür ederim, kal sağlıcakla.

Yalnız benim oluşturduğum formül kesin sonuçları vermez. Şöyleki aranan kelime birden fazla ünvanda ve kodlu sütunda geçiyorsa eşleşmemesi gereken sonuçlar olabilir. Sanırım bunun farkındasındır. Formül detayı eğersay, çokeğersay gibi fonksiyonlar ile geliştirilebilir. Kolaylıklar.

 

[tugkan]

Makrolu alternatif dener misiniz?

 

[polis-53]

Makrolu alternatif dener misiniz?

bazılarını bulamadı neden.

 

[polis-53]

Metin içinde varsa onu yazsın

 

[tugkan]

bazılarını bulamadı neden.

Örnek verir misin? Hangileri?

Metin içinde varsa onu yazsın

Metin içinde derken? Buna da örnek verir misin?

 

[polis-53]

Dosya ektedir

 

[polis-53]

bu kod bazılarını eşleştiremiyor nedeni nedir baktığımda sorunu bulamadım.

Sub KelimeKontrolu()

Dim i As Long
Dim j As Long
Dim HValue As String
Dim AValue As String
Dim kelime As Variant
Dim found As Boolean
Dim HAfterDash As String

' B sütununu temizle
Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).ClearContents

' H sütunundaki verileri döngüye alıyoruz (H sütunu 2. satırdan başlıyor)
For i = 2 To Cells(Rows.Count, "H").End(xlUp).Row
HValue = Cells(i, "H").Value
found = False

' "-" işaretinden sonraki kısmı al
If InStr(HValue, "-") > 0 Then
HAfterDash = Trim(Mid(HValue, InStr(HValue, "-") + 1))
Else
HAfterDash = HValue ' "-" işareti yoksa tamamını al
End If

' H değerindeki her kelimeyi kontrol et
kelimeler = Split(HAfterDash, " ") ' H değerini boşluktan böldük

' A sütunundaki verileri döngüye alıyoruz
For j = 2 To Cells(Rows.Count, "A").End(xlUp).Row
AValue = Cells(j, "A").Value

' Eğer A hücresinde herhangi bir kelime bulunursa
For Each kelime In kelimeler
If InStr(1, AValue, kelime, vbTextCompare) > 0 Then
found = True
Exit For
End If
Next kelime

If found Then
Cells(j, "B").Value = HValue ' B hücresine H hücresindeki değeri yaz
Exit For
End If
Next j
Next i

End Sub
][/QUOTE]

 

[tugkan]

Verilerin kontrol edildiği sütunlar önceki dosyanızdan farklı. Ayrıca Örnek "PAZARLAMA" kelimesi birden fazla yerde geçtiği için makroda karışıklık olabiliyor bu yüzden "-" işaretinden sonraki ilk kelimeyi dikkate alacak şekilde ayarlama yaptım. Bu kod, C sütunundaki hücrelerde bulunan "-" işaretinden sonra gelen ilk kelimeyi alır ve yalnızca bu kelimeyi A sütununda arar. Eşleşme bulunursa, B sütununda ilgili satıra C hücresinin tamamını yazdırır.

Güncellenmiş VBA Kodu

Sub KelimeKontrolu()

    Dim i As Long
    Dim j As Long
    Dim HValue As String
    Dim AValue As String
    Dim kelime As String
    Dim found As Boolean
    Dim dashPosition As Long

    ' B sütununu temizle
    Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).ClearContents

    ' H sütunundaki verileri döngüye alıyoruz (H sütunu 2. satırdan başlıyor)
    For i = 2 To Cells(Rows.Count, "H").End(xlUp).Row
        HValue = Cells(i, "H").Value
        found = False
        
        ' "-" işaretinden sonraki ilk kelimeyi al
        dashPosition = InStr(HValue, "-")
        If dashPosition > 0 Then
            kelime = Trim(Split(Mid(HValue, dashPosition + 1), " ")(0)) ' İlk kelimeyi al
        Else
            kelime = HValue ' "-" işareti yoksa tamamını al
        End If

        ' A sütunundaki verileri döngüye alıyoruz
        For j = 2 To Cells(Rows.Count, "A").End(xlUp).Row
            AValue = Cells(j, "A").Value
            
            ' Eğer A hücresinde kelime bulunursa
            If InStr(1, AValue, kelime, vbTextCompare) > 0 Then
                found = True
                Cells(j, "B").Value = HValue ' B hücresine H hücresindeki değeri yaz
                Exit For
            End If
        Next j
    Next i

End Sub

Kod Açıklaması:

• "-" işaretinden sonraki ilk kelimeyi alma: dashPosition ile "-" işaretinin konumunu buluyoruz. İşaretten sonraki kısmı Split ile boşluklardan ayırıp, ilk kelimeyi alıyoruz. Eğer "-" işareti yoksa, tüm hücreyi kullanıyoruz.
• Arama işlemi: Sadece bu ilk kelimeyi A sütunundaki hücrelerde arıyoruz. Eşleşme bulunursa, C sütunundaki tam değeri B sütunundaki ilgili satıra yazdırıyoruz.

Kodu Çalıştırma:

1. VBA kodunu modülünüze yapıştırın.
2. F5 tuşuna basarak veya Run butonuna tıklayarak makroyu çalıştırın.

Bu düzenlemeyle, C sütunundaki "-" işaretinden sonra gelen ilk kelime baz alınarak A sütununda arama yapılacaktır.

 

[polis-53]

Verilerin kontrol edildiği sütunlar önceki dosyanızdan farklı. Ayrıca Örnek "PAZARLAMA" kelimesi birden fazla yerde geçtiği için makroda karışıklık olabiliyor bu yüzden "-" işaretinden sonraki ilk kelimeyi dikkate alacak şekilde ayarlama yaptım. Bu kod, C sütunundaki hücrelerde bulunan "-" işaretinden sonra gelen ilk kelimeyi alır ve yalnızca bu kelimeyi A sütununda arar. Eşleşme bulunursa, B sütununda ilgili satıra C hücresinin tamamını yazdırır.

Güncellenmiş VBA Kodu

Sub KelimeKontrolu()

    Dim i As Long
    Dim j As Long
    Dim HValue As String
    Dim AValue As String
    Dim kelime As String
    Dim found As Boolean
    Dim dashPosition As Long

    ' B sütununu temizle
    Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).ClearContents

    ' H sütunundaki verileri döngüye alıyoruz (H sütunu 2. satırdan başlıyor)
    For i = 2 To Cells(Rows.Count, "H").End(xlUp).Row
        HValue = Cells(i, "H").Value
        found = False
      
        ' "-" işaretinden sonraki ilk kelimeyi al
        dashPosition = InStr(HValue, "-")
        If dashPosition > 0 Then
            kelime = Trim(Split(Mid(HValue, dashPosition + 1), " ")(0)) ' İlk kelimeyi al
        Else
            kelime = HValue ' "-" işareti yoksa tamamını al
        End If

        ' A sütunundaki verileri döngüye alıyoruz
        For j = 2 To Cells(Rows.Count, "A").End(xlUp).Row
            AValue = Cells(j, "A").Value
          
            ' Eğer A hücresinde kelime bulunursa
            If InStr(1, AValue, kelime, vbTextCompare) > 0 Then
                found = True
                Cells(j, "B").Value = HValue ' B hücresine H hücresindeki değeri yaz
                Exit For
            End If
        Next j
    Next i

End Sub

Kod Açıklaması:

• "-" işaretinden sonraki ilk kelimeyi alma: dashPosition ile "-" işaretinin konumunu buluyoruz. İşaretten sonraki kısmı Split ile boşluklardan ayırıp, ilk kelimeyi alıyoruz. Eğer "-" işareti yoksa, tüm hücreyi kullanıyoruz.
• Arama işlemi: Sadece bu ilk kelimeyi A sütunundaki hücrelerde arıyoruz. Eşleşme bulunursa, C sütunundaki tam değeri B sütunundaki ilgili satıra yazdırıyoruz.

Kodu Çalıştırma:

1. VBA kodunu modülünüze yapıştırın.
2. F5 tuşuna basarak veya Run butonuna tıklayarak makroyu çalıştırın.

Bu düzenlemeyle, C sütunundaki "-" işaretinden sonra gelen ilk kelime baz alınarak A sütununda arama yapılacaktır.

mükerrer olanları yazmıyor yazması gerekir.
bütün satırlarda yazması gerekir yazmıyor. örneğin 18,19,20,21,181....500 satırlara veri yazmıyor
dosya ekte

 

[polis-53]

günaydın arkadaşlar birden fazla olan aynı verileri atmıyor oysa onlara da atması gerekir

 

[walabi]

Makro ile ilgili bilginiz yoksa bence formülle kendiniz yapmaya çalışın. Böylece başkalarına bağımlı kalmazsınız. Sizin dosyanız formülle çözülebilecek düzeydeydi sanırım.

 

[tugkan]

Günaydın,
Uğraşıyordum ama çözemedim Başka birisi bakabilirse iyi olur

 

[polis-53]

Makro ile ilgili bilginiz yoksa bence formülle kendiniz yapmaya çalışın. Böylece başkalarına bağımlı kalmazsınız. Sizin dosyanız formülle çözülebilecek düzeydeydi sanırım.

Formülle uğraştım fakat çözemedim formül yardımında bulunursanız sevinirim.