Hücre İçeriğine Bağlı Olarak İstediğim Sonuçları Verebilecek Fonksiyon

[tiryaki_44]

Merhaba arkadaşlar,

ilgili dosyayı ekledim.

yardımcı olursanız çok sevinirim.

şimdiden çok teşekkür ederim.

 

[Ömer]

Merhaba arkadaşlar,

ilgili dosyayı ekledim.

yardımcı olursanız çok sevinirim.

şimdiden çok teşekkür ederim.

Merhaba,

Sorularınızı sadece dosya içerisinde değil, mesaj içeriğinde de belirtmenizi rica ederim.

Bu istediğinizi fonksiyonla yapmayı tavsiye etmem. Çünkü hücreye yazılan her rakam için bir fonksiyon yazıp bunları birbiriyle birleştirmeniz gerekir.

Makro kullanmanızı tavsiye ederim.

Sub SartliBirlestir()
 
    Dim c As Range, Adr As Variant, a, i As Long
 
    Range("E3").ClearContents
 
    With Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
      a = Split(Range("C3"), ",")
      For i = 0 To UBound(a)
         Set c = .Find(a(i), , xlValues, xlWhole)
           If Not c Is Nothing Then
             Adr = c.Address
               Do
                 If a(i) <> "" Then
                    Range("E3") = Range("E3") & "," & Cells(c.Row, "B")
                 End If
               Set c = .FindNext(c)
               Loop While Not c Is Nothing And c.Address <> Adr
           End If
        Next i
    End With
    
    Set c = Nothing
 
End Sub

 

[tiryaki_44]

Teşekkürler.

Uyarınızı dikkate alacağım.

 

[tiryaki_44]

Acaba aynı işlemi C3 ve E3 hücrelerinin devamında da yapabilir miyiz?
Yani C4 de yazılanlar için sonuçlar E4 de, C5 için E5, C6 için E6 şeklinde devam edebilir mi?

 

[Ömer]

Acaba aynı işlemi C3 ve E3 hücrelerinin devamında da yapabilir miyiz?
Yani C4 de yazılanlar için sonuçlar E4 de, C5 için E5, C6 için E6 şeklinde devam edebilir mi?

Bu şekilde deneyin.

Sub SartliBirlestir()
 
    Dim c As Range, Adr As Variant, a, i As Long, j As Long
 
    Range("E3:E" & Rows.Count).ClearContents
 
    With Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
      For j = 3 To Cells(Rows.Count, "A").End(xlUp).Row
        a = Split(Cells(j, "C"), ",")
        For i = 0 To UBound(a)
           Set c = .Find(a(i), , xlValues, xlWhole)
             If Not c Is Nothing Then
               Adr = c.Address
                 Do
                   If a(i) <> "" Then
                      Cells(j, "E") = Cells(j, "E") & "," & Cells(c.Row, "B")
                   End If
                 Set c = .FindNext(c)
                 Loop While Not c Is Nothing And c.Address <> Adr
             End If
          Next i
      Next j
    End With
 
    Set c = Nothing
 
End Sub

.

 

[tiryaki_44]

çok teşekkürler.