Sub mrshkei()
    Dim arr, arr2, i As Long, n As Long, sh As Worksheet, sh2 As Worksheet, lr As Long, col As New Collection
    Set sh = Worksheets("Лист1"): Set sh2 = Worksheets("Лист2")
    lr = sh2.Cells(Rows.Count, 1).End(xlUp).Row
    arr = sh2.Range("A2:C" & lr)
    For i = LBound(arr) To UBound(arr)
        On Error Resume Next
        col.Add arr(i, 1), CStr(arr(i, 1))
    Next i
    ReDim arr2(1 To col.Count, 1 To 1): k = 1
    For i = 1 To col.Count
    For n = LBound(arr) To UBound(arr)
        If col(i) = arr(n, 1) Then
        If arr2(i, 1) = Empty Then
            arr2(i, 1) = Format(arr(n, 2), "0.0") & " " & arr(n, 3)
        Else
            arr2(i, 1) = arr2(i, 1) & "; " & Format(arr(n, 2), "0.0") & " " & arr(n, 3)
        End If
        End If
    Next n
    Next i
    sh.Columns(3).ClearContents
    sh.Range("C3").Resize(UBound(arr2), 1) = arr2
End Sub