ELIMINA DOPPIONI IN COLONNA TRANNE PRIMO

[luis luis]

Salve a tutti,

ho in colonna A dei valori che possono essere ripetuti parecchie volte  come faccio tramite codice a rimuovere  tutti i doppi tranne

il primo .

grazie 

a11           a11
a11
o22          o22
o22
o22
i35           i35
i35
e50          e50
e50
e50

[vecchio fracSenior Moderator vecchio frac Karma: 245 pts]

Puoi usare Rimuovi duplicati, nella scheda Dati.

[PMC77Partecipante PMC77 Karma: 18 pts]

Oppure puoi scriverti una piccola sub che te li elimini con un piccolo ciclo While...

[PMC77Partecipante PMC77 Karma: 18 pts]

Io proverei con una cosa simile a questa...

 

Sub EliminaDuplicati()

  Dim Row As Integer
  Dim RowMax As Long
  Dim RowNext As Integer
  Dim ValPrec as String

  Dim shWork As Worksheet
  Set shWork = ThisWorkbook.Sheets("nomeFoglio")

  'Inizia il Controllo
  Row = 1
  RowMax = shWork ("A1", shWork ("A1").End(xlDown)).Rows.Count

  While Row <= RowMax

    'Parcheggia il Valore da Verificare/Eliminare (Se Duplicato)
    ValPrec = shWork.Range("A" & Row).Value

    ' Cerca i Successivi Eventualmente Duplicati
    RowNext = Row + 1

    While RowNext <= RowMax

      'Controllo Duplicato
      If ValPrec = shWork.Range("A" & RowNext).Value Then

        'Elimina il Valore Duplicato
        shWork.Range("A" & RowNext).Value = ""

      Else

        'Esce dal Ciclo più Interno
        RowNext = RowMax

      End If

    'Incrementa la Riga per Girare
    RowNext = RowNext + 1

    Wend

  'Incrementa la Riga per Girare
  Row = Row + 1

  Wend

  'Comunica l'Avvenuto Controllo Dati
  R = MsgBox("Duplicati Eliminati!", vbInformation)

End Sub

 

[Mister_x Mister_x]

ciao

come a detto VF usare il rimuovi dupicati

comunque tre esempi di come si puo' elaborare questo con vba

'' macro creata col creatore
Sub Macro1()
Range("A1:A10").Select
ActiveSheet.Range("$A$1:$A$10").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
''''' rimuovere i duplicati eliminando le righe
Sub rimuoviDoppi()
Dim i As Long
For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If Application.CountIf(Range(Cells(1, "A"), Cells(i, "A")), Cells(i, "A")) > 1 Then
Rows(i).Delete
End If
Next i
End Sub
'''' rimuovere lasciando gli spazi
Sub oppureLascia_gli_spazi()
Dim i As Long
For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If Application.CountIf(Range(Cells(1, "A"), Cells(i, "A")), Cells(i, "A")) > 1 Then
Cells(i, "A").ClearContents
End If
Next i
End Sub

[Autore]

Articoli