[Tasos]

Γεια σου Σταύρο!

Eπικόλλησε την παρακάτω συνάρτηση στον VBE:

Function GetFeautureFromProduct(ProductCode As String, _
                                ProductColumn As Range, _
                                FeautureColumn As Range, _
                                StringSeparator As String) _
                                As String
    Dim iRow As Integer
    Dim FirstCellValue As String
    Dim tmp As String
    Dim foundCell As Range


    Set foundCell = ProductColumn.Find(ProductCode, LookIn:=xlValues, _
                                       LookAt:=xlWhole, SearchOrder:=xlByRows, _
                                       SearchDirection:=xlNext, _
                                       MatchCase:=False, SearchFormat:=False)

    If Not foundCell Is Nothing Then
        FirstCellValue = foundCell.Value
        Do
            iRow = foundCell.Row
            If FeautureColumn(iRow) <> vbNullString Then
                tmp = tmp & FeautureColumn(iRow) & StringSeparator
            End If
            Set foundCell = foundCell.Offset(1)
        Loop While foundCell.Value = FirstCellValue
    End If

    If Len(tmp) > 0 Then
        GetFeautureFromProduct = Mid(tmp, 1, Len(tmp) - Len(StringSeparator))
    End If

End Function

Για να λειτουργήσει σωστά η συνάρτηση θα πρέπει η στήλη που περιέχει τους κωδικούς προϊόντων να είναι ταξινομημένη ώστε οι όμοιοι κωδικοί να διατηρούνται μαζί ο ένας κάτω από τον άλλο.

Εάν δεν υπάρχει δυνατότητα ταξινόμησης τότε χρησιμοποίησε την παρακάτω συνάρτηση:

Function GetFeautureFromProduct(ProductCode As String, _
                                 ProductColumn As Range, _
                                 FeautureColumn As Range, _
                                 StringSeparator As String) _
                                 As String
    Dim iRow As Integer
    Dim firstAddress As String
    Dim tmp As String
    Dim foundCell As Range


    Set foundCell = ProductColumn.Find(ProductCode, LookIn:=xlValues, _
                                            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                            MatchCase:=False, SearchFormat:=False)

    If Not foundCell Is Nothing Then
        firstAddress = foundCell.Address
        Do
            iRow = foundCell.Row
            If FeautureColumn(iRow) <> vbNullString Then
                tmp = tmp & FeautureColumn(iRow) & StringSeparator
            End If

                Set foundCell = ProductColumn.Find(ProductCode, After:=foundCell, LookIn:=xlValues, _
                                            LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                            MatchCase:=False, SearchFormat:=False)
            If foundCell Is Nothing Then GoTo ContinueHere
        Loop While foundCell.Address <> firstAddress
    End If

ContinueHere:
    If Len(tmp) > 0 Then
        GetFeautureFromProduct = Mid(tmp, 1, Len(tmp) - Len(StringSeparator))
    End If

End Function

Κατόπιν σε ένα κελί - πχ. BF2- στο φύλλο "excel to csv" πέρασε τον τύπο:

=GetFeautureFromProduct($BE2;xml!$B:$B;xml!$AM:$AM ;",")

Έτσι, σύμφωνα πάντα με τη δομή του παραδείγματος σου, θα έχεις τις εικόνες που αντιστοιχούν σε κάθε κωδικό ενωμένες με διαχωριστικό το κόμμα (,).

Με τον ίδιο τρόπο μπορείς να ενώσεις και άλλες στήλες.του φύλλου "xml".

Καλή συνέχεια!

Τάσος