aggiornare numerazione

Hai un problema con Excel?

Nuova discussione

aggiornare numerazione
di biss73 (utente non iscritto) data: 19/08/2015 18:12:51
Salve a tutti,
ancora a chiedere aiuto:
dovrei aggiornare la numerazione di una colonna "A4" in giu.
tenendo conto che la numerazione e composta da padre ( 1,2,3,4,ecc) e figli ( 1-1,1-2,1-n,3-1,3-n ecc)
a seguito dell'eliminazione di alcune righe vorrei scalare la numerazione.
es.
elimino la riga 10 che a come numero 6, le successive dovrebbero scalare di numerazione compreso i figli,
se un figlio aveva come numerazione 8-1,8-2,8-n deve scalare a 7-1,7-2,7-n ecc per tutte le righe della colonna a.
allego un file di esempio con note con una macro
grazie in anticipo
di Vecchio Frac data: 20/08/2015 08:59:02
Io non vedo un criterio logico nella rinumerazione dei figli.

Prima incongruenza:
Pippo1 era "1" e rimane "1" (è un nodo genitore senza figli).
ma Pippo2 era "2-0" e rimane "2-0" (è un nodo figlio senza genitore "2").

Seconda incongruenza:
Pippo4 era "6-0" e diventa "4-0" (è un nodo figlio senza genitore e parte da zero)
ma Pippo9 era "9-6" e diventa "7-1" (è un nodo figlio senza genitore e parte da 1 invece che da zero)
di Marius44 data: 20/08/2015 09:25:49
@ VF
Ben detto.
Avevo già notato le incongruenze e, in parte, possono essere superate assegnando al dato singolo il suffisso "0" (figli o non figli il dato col suffisso zero è e rimane uno solo). Ho rinumerato la parte sinistra dei dati (ancora non perfetta, mi sono "incartato" nei dati coi figli). Ci sto lavorando sopra. In poche parole la mia idea è questa: assegnare a due matrici, una per la parte sinistra ed una per la parte destra dei dati; rinumerare (o "aggiornare", come dice biss73) la matrice 1 e, quando incontra un dato con suffisso diverso da zero, assegnare il dato di matrice 2.
Che ne pensi? Io credo possa andare. Appena risolvo, posto la sub.
Ciao,Mario
di Biss73 (utente non iscritto) data: 20/08/2015 11:03:59
buon giorno,
Scusatemi mi sono incartato a costruire il file di esempio
in realta il dato 7-1 ( sulla situazione finale ) è 7-0 a crescere.

la prima posizione parte da 1 e i figli prendono nome come una nuova posizione es. 2 seguiti da - 0 ad aumentare ( se ci sono altri figli).
una posizione senza figli avrà solo un numero senza separatore -
la mia intensione è rinominare i dati in colonna A,( la D è per descrivere il risultato ottenuto)
Spero sia piu chiaro
Grazie

di Marius44 data: 20/08/2015 11:07:36
Tutto è bene quel che finisce bene.

@biss73
sostituisci nel tuo foglio la tua sub con quella sottoriportata che scrive i dati ordinati nella colonna D

Fammi sapere se va bene.
Ciao,
Mario

Option Explicit

Sub Aggiorna()
Dim matr1(), matr2(), ns
Dim rg As Integer, a As Integer, pr As Integer, dp As Integer
Dim i As Integer, prec As String, nuovodato As String
    rg = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1 'assume ultima riga
    'trasferisce tutti i dati presenti a matr1
    ReDim matr1(1 To rg), matr2(1 To rg)
    For i = 4 To rg - 1
        ns = Split(Cells(i, 1), "-")
        If UBound(ns) > 0 Then
            pr = ns(0)
            dp = ns(1)
        Else
            pr = ns(0)
            dp = "0"
        End If
        matr1(i) = pr: matr2(i) = dp
    Next i
    'rinumerazione
    a = 1
    For i = 4 To rg - 1
        If matr2(i) = "0" Or _
            (matr2(i) <> "0" And matr1(i) <> matr1(i - 1)) Then a = 1
        If matr2(i) <> "0" Then
            matr2(i) = Trim(Str(a)): a = a + 1
        End If
    Next i
    For i = 4 To rg - 1
        'primo esame
        If i = 4 And matr1(i) = "1" Then
            nuovodato = matr1(i) & "-" & matr2(i): GoTo 1                   'uguale a 1,salta al successivo
        ElseIf i = 4 And Val(matr1(i)) > 1 Then             'maggiore di 1
            matr1(i) = "1": nuovodato = matr1(i) & "-" & matr2(i)
            GoTo 1    'rinumera partendo da 1
        End If
        'secondo esame
        If matr1(i) = Val(matr1(i - 1)) + 1 Then
            prec = matr1(i)
            matr1(i) = Trim(Str(Val(matr1(i - 1)) + 1)) 'rinumera prec+1
            nuovodato = matr1(i) & "-" & matr2(i)
        'terzo esame
        ElseIf matr1(i) > Val(matr1(i - 1)) + 1 Then    'maggiore precedente più di 1 unità
            If prec <> matr1(i) Then
                prec = matr1(i)
                matr1(i) = Trim(Str(Val(matr1(i - 1)) + 1)) 'rinumera prec+1
                nuovodato = matr1(i) & "-" & matr2(i)
            ElseIf prec = matr1(i) Then
                prec = matr1(i)
                matr1(i) = matr1(i - 1)                     'assegna rinum-prec
                nuovodato = matr1(i) & "-" & matr2(i)       'assegna suffisso matr2
            ElseIf Val(matr1(i)) < Val(matr1(i + 1)) Then 'minore del successivo
                prec = matr1(i)
                matr1(i) = Trim(Str(Val(matr1(i - 1)) + 1)) 'rinumera prec+1
                nuovodato = matr1(i) & "-" & matr2(i)
            ElseIf Val(matr1(i)) = Val(matr1(i + 1)) Then    'uguale al successivo
                prec = matr1(i)
                matr1(i) = matr1(i - 1)                     'assegna rinum-prec
                nuovodato = matr1(i) & "-" & matr2(i)       'assegna suffisso matr2
            End If
        End If
1       If matr2(i) = "0" Then nuovodato = matr1(i)
        Cells(i, 4) = nuovodato
    Next i
End Sub

di Marius44 data: 20/08/2015 11:14:05
Mentre postavo hai inserito la tua precisazione.
La routine che t'ho inviato scrive i dati in col.D, numero singolo se non ha figli MA ANCHE SE NON HA figli. I numeri per i figli vanno dall'1 in poi.
Se vuoi "rinominare" (meglio sovrascrivere) in col.A basta cambiare
Cells(i, 4) = nuovodato con ---> Cells(i, 1) = nuovodato

Aspetto tue notizie.
Ciao,
Mario
di biss73 (utente non iscritto) data: 20/08/2015 11:38:48
ciao Marius44 ,
grazie per l' interesse ,
funziona benissimo la tua soluzione solo che i figli devono partire da 2-0 in poi se presenti non devono essere declassati a 2
grazie ancora

di Vecchio Frac data: 20/08/2015 14:57:44
Ho voluto giocare un po' anch'io e vi propino la mia soluzione :)
Uso una Collection in cui la Key è il nome del padre originale, mentre l'Item è un array composto dal nuovo nome del padre ("genitore" nel codice) e dal numero dei suoi figli.
Il cuore è costituito dalla routine che gestisce l'errore (che si scatena al momento dell'inserimento di un figlio ad un padre esistente).

Option Explicit

Sub aggiorna_byVF()
Dim cell As Range, v As Variant
Dim genitore As Integer
Dim padre As Collection, figlio As Integer

    Set padre = New Collection
    On Error GoTo gest_err
    
    For Each cell In Range("A4:A" & Range("A" & Rows.Count).End(xlUp).Row)
    
        genitore = genitore + 1
        If InStr(cell, "-") > 0 Then
            v = Split(cell, "-")
            padre.Add Array(genitore, 0), v(0)
            Cells(cell.Row, "D") = Join(padre(v(0)), "-")
        Else
            padre.Add Array(genitore, 0), cell
            Cells(cell.Row, "D") = genitore
        End If
    Next

    Exit Sub
    
gest_err:
    If Err.Number = 457 Then
        genitore = padre(v(0))(0)
        figlio = padre(v(0))(1) + 1
        padre.Remove v(0)
        padre.Add Array(genitore, figlio), v(0)
        Resume Next
    Else
        Err.Raise Err.Number
        Exit Sub
    End If

End Sub

di Marius44 data: 20/08/2015 17:16:46
@VF
c'è sempre da imparare!

@biss73
Quando si propone un problema bisogna esplicitarlo nel miglior modo possibile.
Nel tuo primo post hai scritto:

tenendo conto che la numerazione e composta da padre ( 1,2,3,4,ecc) e figli ( 1-1,1-2,1-n,3-1,3-n ecc)

e prosegui con:

se un figlio aveva come numerazione 8-1,8-2,8-n deve scalare a 7-1,7-2,7-n ecc

Non hai mai parlato di 2-0 che deve restare 2-0; mi sembra più coerente che se c'è un dato 2-0 significa che ha perso il "padre" ed allora diventa lui "capo-famiglia" perdendo lo zero.

Ciao a tutti,
Mario

di scossa data: 20/08/2015 20:55:50
@Marius44: le variabili destinate a ricevere un valore che rappresenta un numero di riga (o di colonna), come in
rg = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1 'assume ultima riga
dovrebbero essere dichiarate as Long anziché Integer, sia perché il valore potrebbe superare il limite di Integer (32.767), sia per non costringere il compilatore ad una conversione implicita da Long a Integer, visto che le proprietà Row e Column restituiscono un Long.

@Vecchio Frac: la gestione degli errori che hai utilizzato non mi convince per niente: se si avverasse un errore diverso da 457 (gestito) quell'istruzione Err.Raise Err.Number nell'Else manderebbe in loop il codice visto che tornerebbe sempre all'etichetta gest_err:

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)

di Marius44 data: 20/08/2015 22:12:22
@scossa - Grazie per il suggerimento (ci casco spesso ) ma per questo problema oltre 32mila righe mi sembrano tante.

Ciao,
Mario
di Vecchio Frac data: 20/08/2015 22:13:28
Invece dovrebbe convincerti perchè funziona ^_^
Metti un "debug.print 5/0" prima del Next, l'errore verrà sollevato regolarmente e non si creerà nessun loop. Questo, almeno, accade sul mio Excel.

di scossa data: 20/08/2015 22:29:08
cit.: "Metti un "debug.print 5/0" prima del Next"

Metti v = 2/0 subito dopo On Error GoTo gest_err ......

scossa's web site

    On Error GoTo gest_err
    v = 2 / 0

di scossa data: 20/08/2015 22:33:40
Ma anche provando come dici tu con debug.print 5/0 va in loop, e mi sembra logico: Err.Rise solleva un errore e quindi il codice salta all'etichetta impostata con On Eeror Goto Etichetta .....

scossa's web site

di Vecchio Frac data: 21/08/2015 08:10:12
No, mi dispiace contraddirti.
A me non va in loop e genera l'errore regolarmente. Non capisco perchè.
Seven, regolarmente aggiornato dall'Azienda. Excel 2007 (ma funziona anche sul mio Excel 2010 a casa).
Versione VB 6.3, VBA Retail 6.5.1055, Forms3 12.0..6723.500.
Allego immagine della schermata.

di scossa data: 21/08/2015 08:55:29
cit.: "Allego immagine della schermata"

Scusa, ho visto l'immagine ed è quello che succede anche a me; mi sono espresso male io. Parlando di loop intendevo che non ne esci: o premi Fine e allora vabbè, ma se premi Debug poi che fai? se premi F8 torni daccapo ... non mi pare un modo corretto di gestire gli errori.
Sinceramente non capisco l'utilita, in quel codice, di usare Err.Rise, visto che l'oggetto Err ha già la proprietà .Number impostata ad un valore di errrore; nemmeno la successiva istruzione Exit Sub serve, visto che non verrà mai eseguita

scossa's web site

di biss73 (utente non iscritto) data: 21/08/2015 09:25:46
Buon giorno a tutti,
grazie e gentilissimi come sempre
scusatemi se nell'esporre il problema non sono stato molto chiaro
2 soluzioni molto performanti
Grazie ancora
Saluti
di biss73 (utente non iscritto) data: 21/08/2015 10:08:58
Scusatemi ancora una piccola domanda ( senza aprire una nuova discussione)
su listbox1 come faccio ad eliminare un gruppo di righe selezionate?

Grazie
di Vecchio Frac data: 21/08/2015 10:12:16
@scossa
Intendevo mettere in piedi un modo sbrigativo per sollevare comunque l'errore e far terminare il programma, non gestire comunque l'errore. Lo scopo era proprio quello di finire l'esecuzione. Non andrebbe eseguito passo passo. Probabilmente ci sono altri modi. Al metodo Raise passo il numero di errore rilevato così da sollevare l'eccezione che altrimenti sarebbe stata passata sotto silenzio dal Resume Next.
Ho avviato una discussione analoga in Area 51 ma perchè temevo un comportamento anomalo del codice in situazioni analoghe. Invece funziona come previsto (anche se capisco che non è condivisibile) :)
di Vecchio Frac data: 21/08/2015 10:13:52
cit. "su listbox1 come faccio ad eliminare un gruppo di righe selezionate?"
---> Non c'entra niente col problema esposto in questa discussione e meritava una discussione propria :)
A naso comunque devi ciclare gli elementi della listbox e rimuovere gli item selezionati (dove Selected=True).
di biss73 (utente non iscritto) data: 21/08/2015 10:30:52
Grazie Vecchio Frac,
Apro subito una nuova discussione

di scossa data: 21/08/2015 10:54:03
cit.: "Intendevo mettere in piedi un modo sbrigativo per sollevare comunque l'errore e far terminare il programma"

Ah, ok ho capito.

cit: "Lo scopo era proprio quello di finire l'esecuzione. ... Probabilmente ci sono altri modi."

Ad esempio una banale istruzione Stop (vedi sotto)

scossa's web site

     Else
        'Err.Raise Err.Number
        'Exit Sub
        Stop
    End If

di Vecchio Frac data: 21/08/2015 11:03:57
cit. "una banale istruzione Stop (vedi sotto) "
---> LOL... SCIAF (manata in fronte)
...Oppure "End" (avviso per chi legge: non fatelo mai... "End" è un comando troppo brutale, quasi come i Goto).

Vuoi Approfondire?