La consultazione del forum è libera per tutti.
Per poter porre un quesito è invece necessario essere un utente registrato (clicca qui se non lo sei).
Tutti gli utenti che richiedono un supporto, come da REGOLAMENTO, sono caldamente invitati ad allegare un file di esempio con l'indicazione di quello che si desidera ottenere.
Buon giorno,
sono un nuovo utente del forum e mi scuserete se faccio domande fuori luogo.
il mio problema è quello di creare una tabella con le righe che assumono il valore massimo per una determinata colonna (vedi nell'esempio la colonna "COD_TRAT_FIN_ASS_MIN").
In sostanza lo stesso codice, presente in tale colonna, può ripetersi al massimo 3 volte e devo estrarre tutta la riga che assume il massimo valore della colonna "V_GRAVITA".
Ovviamente, per tutti gli altri casi che potrebbero avverarsi dove il codice non si ripete oppure si ripete 2 volte, deve valere la stessa regola, ovvero riportare la riga con il valore massimo di "V_GRAVITA".
Pensavo di usare una combinazione di funzioni "dati.ordina" e "max.più.se", ma essendo principiante non ho trovato la funzione corretta che mi risolva la mia ricerca.
Ringrazio in anticipo chi mi aiuterà nella soluzione al mio quesito e resto a disposizione per eventuali delucidazioni.
Roberto
Ciao
Se ho capito bene (la mancanza di risposte fino ad ora potrebbe dipendere da una non esaustiva spiegazione) potresti provare con questa macro (da assegnare ad un pulsante Modulo (non ActiveX)
Sub riporta_massimo()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim ur As Long, i As Long, j As Long, mx As Long
Dim a As String, b As String
Set sh1 = Sheets("Foglio1")
Set sh2 = Sheets("Foglio2")
ur = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'ultima riga foglio1
ur2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row 'ultima riga foglio2
sh2.Range(sh2.Cells(2, 1), sh2.Cells(ur, 18)).ClearContents 'pulizia foglio2
For i = 2 To ur - 1
For j = i + 1 To ur
If sh1.Cells(i, 17) = sh1.Cells(j, 17) Then
If sh1.Cells(i, 16) > sh1.Cells(j, 16) Then
mx = j - 1
ElseIf sh1.Cells(i, 16) < sh1.Cells(j, 16) Then
mx = j
End If
End If
Next j
ur2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
If mx = 0 Then GoTo salta
sh1.Range(sh1.Cells(mx, 1), sh1.Cells(mx, 18)).Copy
sh2.Range(sh2.Cells(ur2, 1), sh2.Cells(ur2, 18)).PasteSpecial xlPasteValues
mx = 0
salta:
Next i
'elimina doppioni
sh2.Range("$A$1:$R$" & ur2).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7 _
, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18), Header:=xlYes
sh2.Select
sh2.Cells(1, 1).Select
End Sub
Fai sapere. Ciao,
Mario
