[Tasos]

Καλημέρα σε όλους και καλό μήνα!

Χρήστο, δες μια λύση με χρήση VBA στο επισυναπτόμενο αρχείο.

Η συνάρτηση που χρησιμοποιείται στο κελί/κελιά που θα εμφανίζουν το αποτέλεσμα είναι η GroupValues(). Η χρήση της εξηγείται στο συνημμένο.

Option Explicit

Function GroupValues(ByVal strNumbers As String, _
                     Optional ByVal JoinValues As Boolean) As Variant
    Dim strReplaced As Variant, i As Integer, x As Integer
    Dim iPos As Integer, ItemCount As Integer, strTemp As String
    strReplaced = Split( _
                  Replace( _
                  Application.Trim( _
                  Replace(Replace( _
                          strNumbers, ";", vbNullString), ",", " ")), "/", ";"))
    If UBound(strReplaced) > -1 Then
        ReDim ValuesArray(0 To UBound(strReplaced), 0 To 1)
        For i = 0 To UBound(strReplaced)
            iPos = InStr(1, strReplaced(i), ";")
            If iPos Then
                ValuesArray(i, 0) = Left(strReplaced(i), iPos - 1)
                ValuesArray(i, 1) = Mid(strReplaced(i), iPos + 1)
            End If
        Next
        ItemCount = UBound(strReplaced)
        ReDim NewArray(0 To 1000) As String
        For i = 0 To ItemCount
            strTemp = GroupxValues(ValuesArray, ValuesArray(i, 1), ItemCount)
            If strTemp <> vbNullString Then
                NewArray(x) = strTemp
                x = x + 1
            End If
        Next
        If NewArray(0) <> vbNullString Then
            If JoinValues Then
                ReDim Preserve NewArray(x - 1)
                GroupValues = Join(NewArray, ",")
            Else
                GroupValues = NewArray
            End If
        Else
            GroupValues = vbNullString
        End If
    Else
        GroupValues = vbNullString
    End If
End Function

Function GroupxValues(ByRef ValuesArray As Variant, _
                      ByVal strItem As String, _
                      ByVal ItemCount As Integer) As String

    Dim i As Integer, SumValue As Integer
    If strItem = vbNullString Then Exit Function
    For i = 0 To ItemCount
        If ValuesArray(i, 1) = strItem Then
            SumValue = SumValue + ValuesArray(i, 0)
            ValuesArray(i, 1) = vbNullString
        End If
    Next
    If SumValue Then GroupxValues = SumValue & "/" & strItem
End Function

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

Με εκτίμηση

Τάσος