Excel elimina num doppi

[Francesco53]

Buonasera a tutto il Forum,
ho il seguente problema ho in un Range Esempio D4:H9 una serie di numeri alcuni si ripetono
più di una volta e altri solo una. Io vorrei scrivere alcune righe sotto i numeri solo una volta e
raggruppandoli come in figura che allego.

Grazie
Francesco

[Flash30005]

In che senso?

[Francesco53]

Buongiorno,
partendo dalla prima colonna riportare i numeri, e quando si passa alla colonna successiva, se un numero
è già presente nella precedente non metterlo, e così per le altre, in poche parole deve eliminare i numeri
doppi già presenti nelle colonne precedenti.
Francesco

[Anthony47]

Ad esempio:

Codice: Seleziona tutto

Sub piop()
Dim CCC(1 To 90)
Set Sorg = Range("D4:H15")    '<<< Area sorgente
Set Dest = Range("D25")     '<<<< Prima cella di destinazione
'
Set SorgTL = Sorg.Range("A1")
For CCol = 0 To Sorg.Columns.Count - 1
    CDop = 0
    For CRow = 0 To Sorg.Rows.Count - 1
        CCel = SorgTL.Offset(CRow, CCol)
        If CCC(CCel) = 0 Then Dest.Offset(CRow - CDop, CCol) = CCel _
          Else CDop = CDop + 1
        CCC(CCel) = 1
    Next CRow
Next CCol
End Sub


Ciao

[Flash30005]

Prova questa macro

Codice: Seleziona tutto

Sub ElimNumDoppi()
Dim VettN(90) As Integer
Range("D12:H17").ClearContents
For CC = 4 To 8
    For RR = 5 To 10
    VettN(Cells(RR, CC).Value) = VettN(Cells(RR, CC).Value) + 1
        For CC2 = CC To 8
            For RR2 = 12 To 17
            If VettN(Cells(RR, CC).Value) = 1 And Cells(RR2, CC2).Value = "" Then
                Cells(RR2, CC2).Value = Cells(RR, CC).Value
                GoTo saltaRR
            End If
            Next RR2
        Next CC2
saltaRR:
    Next RR
Next CC
End Sub

Ciao

Edit: Leggi il post di Anthony con soluzione (stavo creando la macro e quando l'ho inviata...)

[Francesco53]

Ringrazio entrambi per l'aiuto.
Francesco

[Francesco53]

Sono perfette.
Grazie

[Statix]

Ciao a tutti,
Anthony47, tempo fa aveva già dato una soluzione simile

Codice: Seleziona tutto

Sub collax()
CelleFree = "J1"    '<< Colonna in cui sara' scritto il report
TuArea = "C1:G300" '<< Area con i dati
'
Compen = Range(TuArea).Column
Application.ScreenUpdating = False
For Each Cella In Range(TuArea)
Set CFormArea = Range(TuArea).Offset(Cella.Row).Resize(Range(TuArea).Rows.Count - Cella.Row +1)
If Application.WorksheetFunction.CountIf(CFormArea, Cella.Value) = 0 Then _
   Range(CelleFree).Offset(Rows.Count - 1, Cella.Column - Compen).End(xlUp).Offset(1, 0) = Cella.Value
Next Cella
Application.ScreenUpdating = False
End Sub