Troszkę bardziej ale tylko troszkę, chyba że w dalszym ciągu to jeszcze nie to.
Wyszukane Symbole z ilością wiekszą od 0 są zrzucane do arkusza2 do pierwszej i drugiej kolumny.
Sub zbij()
Dim a As Byte
Dim b As Byte
Dim un(100) As typUnia
'cztery wiersze niżej wypełniają tablicę, cos tam muszę mieć
For a = 0 To 100
un(a).Symbol = Cells(a + 1, 1)
un(a).ilosc = Cells(a + 1, 2)
Next a
For a = 0 To 100 ' pętla dla tablicy
If un(a).ilosc > 0 Then
For b = 1 To Sheets("Arkusz2").Range("A65536").End(xlUp).Row ' Pętla dla wyszukanych danych w arkuszu2
If Sheets("Arkusz2").Cells(b, 1) = un(a).Symbol Then
Sheets("Arkusz2").Cells(b, 2) = Sheets("Arkusz2").Cells(b, 2) + un(a).ilosc
Exit For
End If
Next b
If b = Sheets("Arkusz2").Range("A65536").End(xlUp).Row + 1 Then
Sheets("Arkusz2").Range("A65536").End(xlUp).Offset(1, 0) = un(a).Symbol
Sheets("Arkusz2").Range("A65536").End(xlUp).Offset(0, 1) = un(a).ilosc
End If
End If
Next a
End Sub
Pewnie można efektywniej, ale przy tak krótkiej tablicy i tak niewiele to zmieni.
Pozdrawiam |