Spróbuj tak:
Sub raport()
Dim unikat1 As New Collection, unikat2 As New Collection, licznik1 As Long, komunikat As String
With Sheets("Arkusz1")
'lista unikat1ów
On Error Resume Next
For licznik1 = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
unikat1.Add .Cells(licznik1, 1), CStr(.Cells(licznik1, 1))
Next licznik1
Err.Clear
'tworzenie komunikatu
For licznik1 = 1 To unikat1.Count
komunikat = komunikat & vbNewLine & unikat1(licznik1)
For licznik2 = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
If .Cells(licznik2, 1) = unikat1(licznik1) Then
unikat2.Add .Cells(licznik2, 2), CStr(.Cells(licznik2, 2))
If Err.Number = 0 Then komunikat = komunikat & vbNewLine & Cells(licznik2, 2)
Err.Clear
End If
Next licznik2
Set unikat2 = New Collection
Next licznik1
On Error GoTo 0
End With
MsgBox komunikat
End Sub
Zdajesz sobie sprawę, że Msgbox ma ograniczoną liczbę znaków? |