Używasz funkcji arkuszowych w VBA co w tym przypadku nie jest zbyt optymalnym rozwiązaniem. Sugeruję oprzeć się tylko na VBA.
Sub adr_umowa()
Dim i As Long, j As Long, licznik As Integer, unikaty As New Collection
With Sheets("Arkusz1")
On Error Resume Next
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
unikaty.Add .Cells(i, 1), CStr(.Cells(i, 1))
Next i
On Error GoTo 0
'przepisanie unikatów do arkusza
For i = 1 To unikaty.Count
.Cells(i + 1, 2) = unikaty(i)
Next i
.Cells(i + 1, 2) = "Koniec"
'ponownie przebiegamy po nr umów aby wyszukać adresy
For j = 2 To unikaty.Count + 1
licznik = 2
For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(j, 2) = .Cells(i, 1) Then
licznik = licznik + 1
.Cells(j, licznik) = .Cells(i, 1).Address(0, 0) ' tu można wstawić np hiperłącze
End If
Next i
Next j
End With
End Sub
Wykonanie kodu można znacznie przyśpieszyć przy dość dużej ilości danych, ale stanie się on wtedy trochę bardziej skomplikowany.
Jeśli chcesz zrobić to formułami to możemy do tego wrócić, ale proponuję bez VBA (czyste formuły jednak bez tablicowych pewnie się nie obędzie) |
wstecz 1 dalej
otwarty rozpoczął: entrelec
postów: 4
