
Sub Macro1()
'
' Macro1 Macro
'
'
Range("A3:A49").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-42
Range("O3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$O$3:$O$49").RemoveDuplicates Columns:=1, Header:=xlNo
Range("P3").Select
End Sub |
Sub prova()
Dim rng As Range, tipo As Range, cella As Range
Dim col As Collection
Dim valore As Variant
Dim lista As String
Dim ur As Integer, r As Integer
Dim tip As Integer, tot As Integer, peso As Integer
Application.ScreenUpdating = False
With Sheets("foglio1")
ur = .Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range(.Cells(1, 1), .Cells(ur, 1))
Set col = New Collection
On Error Resume Next
For Each tipo In rng
tipo = Trim(tipo)
col.Add tipo.Value, CStr(tipo.Value)
Next
For Each valore In col
If valore <> "" Then
For Each cella In rng
If cella.Value = valore Then
tip = tip + 1
End If
Next
Sheets("foglio1").Cells(r + 3, 4) = valore
Sheets("foglio1").Cells(r + 3, 5) = tip
r = r + 1
tip = 0
End If
Next
End With
End Sub |
