RAGGRUPPAMENTO DATI

Hai un problema con Excel?

Nuova discussione

RAGGRUPPAMENTO DATI
di Ale53 (utente non iscritto) data: 29/08/2016 15:20:42
Ciao a tutti,
devo raggruppare una lista di numeri (positivi e negativi) da un'unica colonna in due distnte colonne, sempre nello stesso foglio, senza celle vuote tra i numeri.
I numeri nella colonna principale non sono tutti di seguito ma ci sono delle celle vuote (le celle vuote non sono sempre le stesse) tra un numero e l'altro.

Spero di essermi spiegato abbastanza bene.

Grazie in anticipo per le risposte.

Ale53

P.S.: COME SI FA' AD INVIARE SUBITI ASSIEME ALLA DISCUSSIONE IL FILE DA ALLEGARE ? IO NON RIESCO A TROVARE IL PULSANTE.
di Albatros54 data: 29/08/2016 15:23:22
In basso a Dx nella pagina dove hai postato trovi il pulsante Allega File.
RAGGRUPPAMENTO DATI
di Ale53 (utente non iscritto) data: 29/08/2016 15:30:44
Grazie per la dritta.

Veloce come sempre.

File allegato.

di alfrimpa data: 29/08/2016 15:56:21
Ciao Ale

Prova con la macro che vedi sotto che ho inserito nel file allegato.

Ovviamente andrebbe poi modificata in base alle tue reali esigenze.

Alfredo

Sub prova()
Dim rng As Range
Dim cel As Range
Dim ur1 As Long
Dim ur2 As Long
Set rng = Range("C5:c20")
For Each cel In rng
ur1 = Cells(Rows.Count, 5).End(xlUp).Row
ur2 = Cells(Rows.Count, 6).End(xlUp).Row
    If cel.Value < 0 Then
        Cells(ur1 + 1, 5).Value = cel.Value
        Else
        Cells(ur2 + 1, 6).Value = cel.Value
    End If
Next cel
End Sub

RAGGRUPPAMENTO DATI
di Ale53 (utente non iscritto) data: 29/08/2016 16:12:24
Grazie Alfredo,

come dicevo prima "sempre veloce", (non solo tu ovviamente, ma tutti voi)

Tutto funziona.

Ale53
di alfrimpa data: 29/08/2016 22:26:24
Ale grazie.

Volevo solo aggiungere che lo zero, qualora vi fosse, verrebbe catalogato tra i numeri positivi.

Alfredo
di Cucù data: 30/08/2016 08:38:06
@ Alfredo
Ciao Alfredo...
Complimenti per la soluzione ma...
volevo chiederti come mai hai inserito il calcolo delle ultime righe piene all'interno del ciclo anzichè calcolarle prima e poi incrementare solo quella che risponde "True" all'If che hai costruito?
Cordialmente Cucù
di alfrimpa data: 30/08/2016 09:58:09
Ciao Cucù e bentornato (era un po' che non ti si vedeva ).

Quanto alla tua domanda ti rispondo dicendo che è la prima che mi è venuta e funzionando bene non ho pensato ad altre alternative.

In verità avevo messo prima del ciclo le due istruzioni ma, ovviamente, mi prendeva solo l'ultimo valore non avendo previsto l'incremento delle due variabili al verificarsi del TRUE dell'If.

Comunque se posti la soluzione di come l'avresti scritta tu mi faresti cosa gradita.

Un caro saluto.

Alfredo

di Cucù data: 30/08/2016 10:09:11
Ogni tanto ritornano... ^_^
Modificando il tuo codice...

Sub prova1()
Dim rng As Range
Dim cel As Range
Dim ur1 As Long
Dim ur2 As Long
Set rng = Range("C5:c20")
ur1 = Cells(Rows.Count, 5).End(xlUp).Row
ur2 = Cells(Rows.Count, 6).End(xlUp).Row

For Each cel In rng
    If cel.Value < 0 Then
        Cells(ur1 + 1, 5).Value = cel.Value
        ur1 = ur1 + 1
        ElseIf cel.Value <> "" Then
        Cells(ur2 + 1, 6).Value = cel.Value
        ur2 = ur2 + 1
    End If
Next cel

End Sub

di alfrimpa data: 30/08/2016 10:27:21
Si Cucù grazie è come me la ero immaginata.

Ma secondo te che differenza c'è con la mia?

Alfredo

di Cucù data: 30/08/2016 11:50:08
Bhe la tua versione calcola per ogni cella del range C5:c20 il valore delle ultime due righe piene delle colonne 5 e 6.
Ma mettiamo il caso che la cella sia vuota... perchè calcolare questi 2 valori?
Se il valore della cella è negativo, perchè calcolarsi anche il valore dell'ultima cella piena della colonna con i valori positivi?
in conclusione per ottimizzare il codice (tempo di esecuzione) sarebbe più semplice (a mio modo di vedere) fare come da variazione...
Non so se sono riuscito a spiegarmi...
fai un test sostituendo C20 con C2000

Option Explicit

Sub prova()
Dim rng As Range
Dim cel As Range
Dim ur1 As Long
Dim ur2 As Long
Set rng = Range("C5:c2000")
For Each cel In rng
ur1 = Cells(Rows.Count, 5).End(xlUp).Row
ur2 = Cells(Rows.Count, 6).End(xlUp).Row
    If cel.Value < 0 Then
        Cells(ur1 + 1, 5).Value = cel.Value
        Else
        Cells(ur2 + 1, 6).Value = cel.Value
    End If
Next cel
End Sub


Sub prova1()
Dim rng As Range
Dim cel As Range
Dim ur1 As Long
Dim ur2 As Long
Set rng = Range("C5:c2000")
ur1 = Cells(Rows.Count, 5).End(xlUp).Row
ur2 = Cells(Rows.Count, 6).End(xlUp).Row

For Each cel In rng
    If cel.Value < 0 Then
        Cells(ur1 + 1, 5).Value = cel.Value
        ur1 = ur1 + 1
        ElseIf cel.Value <> "" Then
        Cells(ur2 + 1, 6).Value = cel.Value
        ur2 = ur2 + 1
    End If
Next cel

End Sub

di Vecchio Frac data: 30/08/2016 13:13:33
Mamma che pignolo :)
RAGGRUPPAMENTO DATI
di Ale53 (utente non iscritto) data: 30/08/2016 15:52:40
Ciao Alfredo,
ho letto solo ora le altre risposte,
per la questione dello zero, non ci sono problemi in quanto non verrà mai fuori per i calcoli fatti.

Io ho solo aggiunto l'azzeramento delle colonne del calcolo, cosicchè ogni volta partono sempre dalle stesse celle e non continuano ad aggiungersi ai numeri già presenti.

Grazie ancora, MEGLIO ESSERE PIGNOLI CHE CORREGGERE DOPO !
Ale53
di Cucù data: 31/08/2016 10:30:04
Mamma che pignolo :)

Ho avuto un ottimo maestro!!! ^_^
di Vecchio Frac data: 31/08/2016 11:29:07
Infatti era saltato all'occhio anche a me ma non volevo smontare la proposta di Alfrimpa che è ottima quindi sono stato zitto :)
di alfrimpa data: 31/08/2016 11:40:57
Intanto ringrazio VF per le parole.

Come ho spesso detto ho imparato il VBA sul campo e pur avendo molti testi sull'argomento non arrivo a certe "finezze".

In effetti mi considero un "artigiano" del VBA; un buon artigiano direte voi ma pur sempre un artigiano.

Alfredo
di totygno71 data: 31/08/2016 19:11:03
Anche io ho fatto i mie complimenti ad Alfredo... Non ho mica criticato il suo lavoro...
di alfrimpa data: 31/08/2016 19:31:43
Ciao Totygno e ben tornato (è un po' che non ti si vedeva )

Cit. "Anche io ho fatto i mie complimenti ad Alfredo... Non ho mica criticato il suo lavoro..."

Ma oltre questo non vedo altri post

Quando saresti intervenuto? (e comunque ti ringrazio per i complimenti).

Alfredo
di totygno71 data: 31/08/2016 20:16:40
Sorry
era una risposta scritta ma mai inviata...
di alfrimpa data: 31/08/2016 20:22:25
Vabbè come si dice: "L'importante è il pensiero"

Alfredo

di scossa data: 31/08/2016 20:44:04
Giusto per partecipare, il codice sotto è una piccola variazione sul tema.

Lato formule invece propongo queste due formule, sicuramente migliorabili:

per i numeri negativi:
=SE.ERRORE(-DESTRA(INT(GRANDE(SE(($C$5:$C$35<0);$C$5:$C$35-1000*RIF.RIGA($C$5:C35);"");RIF.RIGA(A1:A31)))/100;2);"")

oppure:
=SE.ERRORE(-RESTO(-INT(GRANDE(SE(($C$5:$C$35<0);$C$5:$C$35-1000*RIF.RIGA($C$5:C35);"");RIF.RIGA(A1:A31)))/100;1)*100;"")

per i positivi:
=SE.ERRORE(--DESTRA(INT(PICCOLO(SE(($C$5:$C$35>0);$C$5:$C$35+1000*RIF.RIGA($C$5:C35);"");RIF.RIGA(A1:A31)))/100;2);"")

oppure:
=SE.ERRORE(RESTO(INT(PICCOLO(SE(($C$5:$C$35>0);$C$5:$C$35+1000*RIF.RIGA($C$5:C35);"");RIF.RIGA(A1:A31)))/100;1)*100;"")

da inserire ognuna in una colonna dopo aver selezionato tante righe quante quelle che contengono i dati in colonna (entrambe matriciali, quindi da confermare con ctrl+maiusc+invio)

scossa's web site

Se tu hai una mela, ed io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno. Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

Sub prova()
  Dim ws As Worksheet
  Dim rng As Range
  Dim cel As Range
  Dim nRowNeg As Long
  Dim nRowPos As Long
  
  Set ws = ActiveSheet
  Set rng = ws.Range("C5:C30")
  rng.Offset(0, 2).Resize(, 2).ClearContents 'pulisco le colonne E ed F
  nRowNeg = rng.Row
  nRowPos = nRowNeg
  For Each cel In rng
    With cel
      If .Value < 0 Then
        ws.Cells(nRowNeg, "E").Value = .Value
        nRowNeg = nRowNeg + 1
      ElseIf .Value > 0 Then
        ws.Cells(nRowPos, "F").Value = .Value
        nRowPos = nRowPos + 1
      End If
    End With
  Next cel
  Set ws = Nothing
End Sub

Vuoi Approfondire?