Eliminare valore unico

Buon Mercoledi Forum , nel mio foglio allegato ,facendo una ricerca verticale partendo dalla cella K2 finendo alla cella AL500 mi servirebbe una macro che mi tiene i valori uguali se
trovati nel Range indicato e mi cancella il valore
se trovato da solo (univico).Faccio qualche esempio valore 134 presente in K2 e non presente in altre celle,questo valore la macro deve cancellarlo.Valore 101 presente in L2 e in M2 la macro deve tenere tutti e 2 i valori .Valore 904 presente in K3 ,la macro deve cancellarlo perchè unico.Valore 9826 presente in 28 celle la macro deve tenerli tutti e 28 e via via per tutti gli altri numeri.Spero di essere stato chiaro.Saluti Matteo

Devi impostare un ciclo For Each sull’intervallo.

Poi con un If ed un CONTA.SE() lato VBA (WorksheetFunction.CountIf) valuti se il valore della cella è presente più di una volta.

Se presente una volta cancelli il contenuto della cella.

È una macro semplicissima.

Sub cancella Univoci

Application.ScreenUpdating = False
Dim NRcX As Long, Nrc As Long, x As Long
Dim Rcr As Integer
Dim z As Integer, w As Integer, j As Integer
Dim y As Byte, k As Byte
For y = 11 To 28



Buon Giorno Alfredo grazie della indicazioni ma non ho le tue competenze per quanto riguarda Vba. Provo a partire con la macro sopra
se me la finisci potresti indicarmi passo passo le istruzioni cosi imparerei qualcosa di nuovo,ti ringrazio Matteo

No il codice non te lo do.

Se non si studia la competenza non si forma mai (credi che son nato con il VBA in testa?)

Comincia a studiare questo link sul ciclo For Each (ma ne trovi quanti ne vuoi basta solo volerlo) e prova a scrivere qualcosa di sensato piuttosto che buttare giù del codice a casaccio giusto per far vedere.

https://macrovba.wordpress.com/tag/ciclo-for-each-next/

Mi sembra che con oltre 300 post sia quanto meno doveroso farlo.

Sub cancellaUnivochi()
Dim setArea As Range
Dim cel As Range
setArea = Range("K2:AL500")
For Each cel In setArea
If cel.Value = " " Or cel.Value = " " Or cel.Value = " " Then
cel.EntireRow.ClearContents
End If
Next cel
End Sub

Buongiorno Alfrimpa https://macrovba.wordpress.com/tag/ciclo-for-each-next/ molto interessante non sapevo di questo sito,non voglio un codice chiavi in mano ma potresti aiutare un po di piu,non metto giù i codici a caso.Sono arrivato fino a qui ora come posso proseguire?Saluti

Mi spieghi cosa intendevi fare con questa istruzione?



E poi dove sono le istruzioni per rilevare i valori univoci? Quel WorksheetFunction.CountIf che ti ho segnalato prima?

Sub cancellaUnivochi()
Dim setArea As Range
Dim cel As Range
setArea = Range("K2:AL500")
Dim Intervallo ("K2:AL500")
Dim Riga As Long
Set Intervallo = setArea
For Each cell IN setArea
If Application.CountIf(Intervallo, cell.Value) = 0 Then '
End if
Next
End Sub

Buon Giorno Alfredo vorrei far trovare alla macro le corrispondenze uguali e cancellare tutto il resto,da solo non riesco,
può andare bene un codice tipo cosi ovviamente ritoccandolo?Saluti

Mi puoi spiegare istruzione per istruzione cosa intendevi fare?

Nel codice che hai postato c’è qualcosa di corretto ma anche strafalcioni da doppio frego blu.

Se non studi come puoi pensare di scrivere codice che abbia una logica ed un senso?

Forse posso sembrare “cattivo” nel mio comportamento.

Però a me interessa relativamente risolvere il tuo problema.

Mi interessa molto di più che tu impari in modo da essere in grado di risolverlo da solo.

Buon giorno Alfredo non ti ritengo Cattivo,anzi un ottimo Guru,ti seguo anche sul Web ma se vuoi aiutare inizia
a sottolineare gli errori e sottolinea le cose giuste spiegando il perchè degli errori io non ho fretta ti avere il codice in mano ne tanto meno di avere la pappa pronta.Saluti Matteo.

Inizia tu con lo spiegare secondo quale ragionamento hai scritto le istruzioni del codice che hai postato ed io ti dirò che cosa c’è di sbagliato nel ragionamento e cosa no.

Ciao a tutti
ciao Matteo,
Alfredo (un saluto )
ti ha già fornito il ragionamento al post #2.

È composto da 3 passaggi, analizzarli uno la volta, ed uno alla volta
mettili.in pratica.

DOPO e ripeto, DOPO,
assembla tutto in un'unica macro.

Ciao
Frank

Sub MacroEliminareValoriunici()
'
' MacroEliminareValoriunici Macro
'

'
Range("K2:AL500").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.399945066682943
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub





Buon Giorno Alfredo buongiorno Taninom che bello rivederti dopo tanto tempo,non voglio fare di testa mia è solo una considerazione magari non vi piacerà ma è solo una considerazione ripeto,arrivato a questo punto la macro sopra che vedete,posso dire ad excel di cancellarmi tutto il resto a parte le celle formattate con testo grigio?A presto matteo

Buona giornata ABCDEF@Excel,ho provato la tua macro ma alla fine mi arriva il messaggio "fatto" ma non cancella nessun valore,in attesa di una tua eventuale modifica ti ringrazio Matteo

Per il futuro....

Sub cancellaUnivochi()
' errore ... Dim setArea As Range
Dim cel As Range
Dim Intervallo As Range '''''manca
' errore ... setArea = Range("K2:AL500")
' errore ... Dim Intervallo ("K2:AL500")
' errore ... Dim Riga As Long
' errore ... Set Intervallo = setArea
Set Intervallo = Range("K2:AL500") '''''''manca
' errore ... For Each cell IN setArea
For Each cel In Intervallo
If Application.CountIf(Intervallo, cel.Value) = 1 Then 'cel & 1
cel = "" 'manca cosa deve fare
End If
Next
Set Intervallo = Nothing '''''''manca
End Sub

Per risparmiare CPU, ad Each preferisco due cicli for = 590 celle contro 13972
Facile dire che non funziona, il motivo...l'allegato che non funziona?

Ciao ABCDEF@Excel, grazie per gli errori segnalati,allego il file senza aver formattato le celle,ho messo la tua macro ma nell'eseguirla non ho nessuna cancellazione.Saluti Matteo

>>> c = Cells(Rows.Count, 1).End(xlUp).Row
c = Cells(Rows.Count, x).End(xlUp).Row

Grazie ABCDEF@Excel del codice.Saluti e buon sabato Matteo