excel help

Sub test()
    Dim a, i As Long, ii As Integer, b(), n As Long, x
    With ActiveSheet.Range("A:B").CurrentRegion
        a = .Value
        .ClearContents
    End With
    ReDim b(1 To UBound(a, 1), 1 To 2)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                n = n + 1
                b(n, 1) = a(i, 1)
                .Add a(i, 1), n
            End If
            x = .Item(a(i, 1))
            For ii = 2 To UBound(a, 2)
                If a(i, ii) = "" Then Exit For
                b(x, 2) = b(x, 2) & "," & a(i, ii)
            Next
        Next
    End With
    Sheets("sheet2").Range("a1").Resize(n, 2).Value = b
End Sub

smetko je 10. okt 2013 ob 14:43 izjavil:

Brez makrojev: http://office.microsoft.com/en-us/excel...