Çözüldü Makina Kodlarını Bulmak

[Gata]

Makine Kodlarının Listesini Tek Hücrede Gösterme, ayrı hücrelerdeki değerlerin bir hücrede yazılmasının nasıl yapılması 365 göre yapılmış olup eski versiyonlara yapabilirmisiniz selamlar hayırlı kandiller

 

[Gata]

Soruna yardımcı olacak arkadaş yok mu

 

[ÖmerFaruk]

Klasik Formüllerle çok zor.
Mecburen UDF ile yapmak zorunda kaldım.
Aşağıdaki kodları Excel dosyasına VBA penceresine yeni bir modül oluşturarak içine ekleyin.

Sayfanızda Listesini almak istediğiniz hedef hücrede yani formül istediğiniz yerde
=MakineKod(B3:E11) şeklinde kullanabilirsiniz.
Seçilen bu aralıkta İlk sütun Makine kodlarını, yandaki sütunlar (istediğiniz kadar uzatabilrisiniz) Ürün kodları olmak zorunda.

Function MakineKod(Kaynak As Range)
    Dim dict As Object, arrList As Object, Dizi, Liste, i As Long, k As Long
    Set dict = CreateObject("Scripting.Dictionary")
    Set arrList = CreateObject("System.Collections.ArrayList")
    Dizi = Kaynak.Value
    For i = 1 To UBound(Dizi, 1)
        For k = 2 To UBound(Dizi, 2)
            If Dizi(i, k) <> "" Then
                If Not dict.Exists(Dizi(i, k)) Then dict.Add Dizi(i, k), Dizi(i, 1) Else dict(Dizi(i, k)) = dict(Dizi(i, k)) & "//" & Dizi(i, 1)
            End If
        Next k
    Next i
    For Each Key In dict: arrList.Add Key: Next Key
    arrList.Sort
    ReDim Liste(1 To dict.Count, 1 To 2)
    For i = 1 To dict.Count
        Liste(i, 1) = arrList(i - 1)
        Liste(i, 2) = ItemsSort(dict(arrList(i - 1)))
    Next i
    Set dict = Nothing: Set arrList = Nothing: Erase Dizi
    MakineKod = Liste: Erase Liste
End Function

Function ItemsSort(Metin As Variant) As String
    Dim i As Long, j As Long, n As Long
    Dim temp As String, Dizi
    Dizi = Split(Metin, "//")
    n = UBound(Dizi)
    For i = 0 To n - 1
        For j = i + 1 To n
            If UCase(Dizi(i)) > UCase(Dizi(j)) Then
                temp = Dizi(j)
                Dizi(j) = Dizi(i)
                Dizi(i) = temp
            End If
        Next j
    Next i
    ItemsSort = Join(Dizi, "; ")
End Function

 

[Gata]

Klasik Formüllerle çok zor.
Mecburen UDF ile yapmak zorunda kaldım.
Aşağıdaki kodları Excel dosyasına VBA penceresine yeni bir modül oluşturarak içine ekleyin.

Sayfanızda Listesini almak istediğiniz hedef hücrede yani formül istediğiniz yerde
=MakineKod(B3:E11) şeklinde kullanabilirsiniz.
Seçilen bu aralıkta İlk sütun Makine kodlarını, yandaki sütunlar (istediğiniz kadar uzatabilrisiniz) Ürün kodları olmak zorunda.

Function MakineKod(Kaynak As Range)
    Dim dict As Object, arrList As Object, Dizi, Liste, i As Long, k As Long
    Set dict = CreateObject("Scripting.Dictionary")
    Set arrList = CreateObject("System.Collections.ArrayList")
    Dizi = Kaynak.Value
    For i = 1 To UBound(Dizi, 1)
        For k = 2 To UBound(Dizi, 2)
            If Dizi(i, k) <> "" Then
                If Not dict.Exists(Dizi(i, k)) Then dict.Add Dizi(i, k), Dizi(i, 1) Else dict(Dizi(i, k)) = dict(Dizi(i, k)) & "//" & Dizi(i, 1)
            End If
        Next k
    Next i
    For Each Key In dict: arrList.Add Key: Next Key
    arrList.Sort
    ReDim Liste(1 To dict.Count, 1 To 2)
    For i = 1 To dict.Count
        Liste(i, 1) = arrList(i - 1)
        Liste(i, 2) = ItemsSort(dict(arrList(i - 1)))
    Next i
    Set dict = Nothing: Set arrList = Nothing: Erase Dizi
    MakineKod = Liste: Erase Liste
End Function

Function ItemsSort(Metin As Variant) As String
    Dim i As Long, j As Long, n As Long
    Dim temp As String, Dizi
    Dizi = Split(Metin, "//")
    n = UBound(Dizi)
    For i = 0 To n - 1
        For j = i + 1 To n
            If UCase(Dizi(i)) > UCase(Dizi(j)) Then
                temp = Dizi(j)
                Dizi(j) = Dizi(i)
                Dizi(i) = temp
            End If
        Next j
    Next i
    ItemsSort = Join(Dizi, "; ")
End Function

Teşekkür ederim Ömer Faruk hocam emeğinize sağlık iyi günler dilerim selamlar Allaha emanet olun