Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

[Excel] Macro per numerazione progressiva

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

[Excel] Macro per numerazione progressiva

Postdi marte1503 » 06/01/12 09:15

Ciao a tutti

Ho una Tabella alla quale (tramite macro) a volte vengono aggiunte righe, a volte vengono eliminate, (range iniziale C6:U6).
A sinistra della Tabella, cioè in ColonnaB (partendo da B6) ho una numerazione progressiva che vorrei si riaggiornasse automaticamente tramite macro, ogni volta che viene modificato il range della Tabella.

Ps.
(Pensavo di inserire il nuovo codice che mi creereste ai piedi della macro che aggiunge o elimina righe. Potrebbe funzionare?)

Grazie
marte
marte1503
Utente Senior
 
Post: 174
Iscritto il: 08/01/10 20:43
Località: Como

Sponsor
 

Re: [Excel] Macro per numerazione progressiva

Postdi wallysimpsons » 06/01/12 15:05

Ciao e buon anno

Potresti contare le righe ad inserire il valore nella cella desiderata

Codice: Seleziona tutto
Dim x, Cl
'
x = 1
For Each Cl In Range("C6:C1000")
If Cl <> "" Then
Cl.Offset(0, -1).Value = x
Else
Cl.Offset(0, -1).Value = ""
End If
x = x + 1
Next


Dovrebbe funzionare

Ciao, Wally.
Wally (Excel 2007)
Avatar utente
wallysimpsons
Utente Junior
 
Post: 11
Iscritto il: 25/11/09 14:09

Re: [Excel] Macro per numerazione progressiva

Postdi Anthony47 » 06/01/12 21:08

Una variante alla proposta di wally (vedi sopra) e' questa:
Codice: Seleziona tutto
Sub renum()
'ActiveSheet.ListObjects("Tabella1").ListColumns(1).DataBodyRange.Offset(0, -1).ClearContents
'
For Each Cell In ActiveSheet.ListObjects("Tabella1").ListColumns(1).DataBodyRange
I = I + 1: Cell.Offset(0, -1) = I
Next Cell
End Sub

Puoi inserire le tre istruzioni For each /Next in coda al codice che "allunga" la tabella.

La prima istruzione, ora "commentata" e quindi non eseguita, andrebbe messa prima di variare l' altezza della tabella per cancellare la numerazione precedente; infatti se la tabella venisse accorciata con istruzioni che lavorano solo sulla tabella (tipo ListObject.ListRows.Add) e non l' intera riga allora le istruzioni For each /Next lascerebbero una numerazione spuria in corrispondenza delle righe eliminate. Se invece lavori sull' intera riga il problema non si pone e puoi ignorare quella riga (che comunque non fa male).

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Macro per numerazione progressiva

Postdi marte1503 » 06/01/12 23:09

Ciao Wally, ciao Anthony.

Anthony, ho inserito le righe di codice: la riga commentata togliendo apice e messa prima della variazione tabella, il resto ai piedi della macro esistente. Tutto funziona perfettamente se la Tabella conserva almeno una riga di dati, se invece tutte le righe Tabella vengono eliminate la macro si interrompe e mi dà l’errore alla riga:

Codice: Seleziona tutto
For Each Cell In ActiveSheet.ListObjects("Tabella162425").ListColumns(1).DataBodyRange
Dandomi un errore di run-time ‘424’: necessario oggetto

Che devo fare?
Grazie
marte1503
Utente Senior
 
Post: 174
Iscritto il: 08/01/10 20:43
Località: Como

Re: [Excel] Macro per numerazione progressiva

Postdi Anthony47 » 07/01/12 00:11

E ti lascia eliminare tutte le righe della tabella?
Comunque prova questa sofisticata variante
Codice: Seleziona tutto
Sub renum()
'ActiveSheet.ListObjects("Tabella1").ListColumns(1).Range.Offset(0, -1).ClearContents  'Gia' sai...
'
For Each Cell In ActiveSheet.ListObjects("Tabella1").ListColumns(1).Range
   If I > 0 Then Cell.Offset(0, -1) = I
   I = I + 1
Next Cell
End Sub

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Macro per numerazione progressiva

Postdi marte1503 » 08/01/12 09:12

Ciao Anthony,
c’è ancora qualche problema…
qusta la riga in errore :
Codice: Seleziona tutto
ActiveSheet.ListObjects("Tabella162425").ListColumns(1).DataBodyRange.Offset(0, -1).ClearContents

Errore di run-time “91”: variabile oggetto o variabile del blocco With non impostata

Questa è la macro intera:

Codice: Seleziona tutto
Application.ScreenUpdating = False
Sheets("Foglio79").Select
ActiveSheet.Unprotect
ActiveSheet.ListObjects("Tabella162425").ListColumns(1).DataBodyRange.Offset(0, -1).ClearContents
   With ActiveSheet.ListObjects("Tabella162425")
   .ListRows.Add
  .ListRows(.ListRows.Count).Range.Range("A1").Select
   End With

 UR = Range("D" & Rows.Count).End(xlUp).Row 'cancello le righe eventualmente presenti
If UR < 6 Then UR = 6                       'in tabella162425 per inserire i nuovi
    Rows("6:" & UR).Delete Shift:=xlUp      'dati sempre aggiornati

    With ActiveSheet.ListObjects("Tabella162425")
   .ListRows.Add
  .ListRows(.ListRows.Count).Range.Range("A1").Select
   End With

Sheets("Foglio80").Select
ActiveSheet.Unprotect
 ActiveSheet.ListObjects("Tabella41627").Range.AutoFilter Field:=1, Criteria1:= _
        "<>"
    On Error Resume Next
Set myFiltr = Nothing
Set myFiltr = Range("Tabella41627[Classe]:Tabella41627[Delegati al ritiro 3]").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myFiltr Is Nothing Then
myFiltr.Select
With Range("Tabella41627").SpecialCells(xlCellTypeVisible)
    NewLin = .Count / .Columns.Count     'RigheVis=N° righe visibili
End With
Selection.Copy 'copio il range che incollerò in Griglia

Sheets("Foglio79").ListObjects("Tabella162425").Resize _
Range("Tabella162425").Offset(-1, 0).Resize(Range("Tabella162425").Rows.Count + NewLin + 1)

Sheets("Foglio79").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Sheets("Foglio80").Select
ActiveSheet.ListObjects("Tabella41627").Range.AutoFilter Field:=1
 

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Primo step>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

   Sheets("Foglio79").Select
    With ActiveSheet.ListObjects("Tabella162425")
   .ListRows.Add
  .ListRows(.ListRows.Count).Range.Range("A1").Select
   End With

Sheets("Foglio49").Select
     ActiveSheet.Unprotect
 ActiveSheet.ListObjects("Tabella1151832").Range.AutoFilter Field:=136, Criteria1:= _
        "Esterno"
    On Error Resume Next
Set myFiltr = Nothing
Set myFiltr = Range("Tabella1151832[Colore Classe2]:Tabella1151832[Delegati3+NumeroTel]").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myFiltr Is Nothing Then
myFiltr.Select
With Range("Tabella1151832").SpecialCells(xlCellTypeVisible)
    NewLin = .Count / .Columns.Count     'RigheVis=N° righe visibili
End With
Selection.Copy
Sheets("Foglio79").ListObjects("Tabella162425").Resize _
Range("Tabella162425").Offset(-1, 0).Resize(Range("Tabella162425").Rows.Count + NewLin + 1)

Sheets("Foglio79").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Sheets("Foglio49").Select
ActiveSheet.ListObjects("Tabella1151832").Range.AutoFilter Field:=136


'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Secondo step>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>


   Sheets("Foglio79").Select
   ActiveSheet.Unprotect
    With ActiveSheet.ListObjects("Tabella162425")
   .ListRows.Add
  .ListRows(.ListRows.Count).Range.Range("A1").Select
   End With

Application.AddCustomList ListArray:=Array("Nido", "Esterno")
    ActiveWorkbook.Worksheets("Foglio79").ListObjects("Tabella162425").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("Foglio79").ListObjects("Tabella162425").Sort.SortFields. _
        Add Key:=Range("Tabella162425[Classe]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, CustomOrder:="Nido,Esterno", DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Foglio79").ListObjects("Tabella162425").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
On Error Resume Next
    Sheets("Foglio79").Select
    UR = Range("D" & Rows.Count).End(xlUp).Row
If UR < 6 Then UR = 6
    Range("C6:D" & UR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("A1").Select
    On Error GoTo 0

    Sheets("Foglio79").Select
    Range("Tabella162425").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
            Selection.RowHeight = 60
    End With
  Range("Tabella162425[Classe]").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 90
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    Range("C7:V116").Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0.249977111117893
        .PatternTintAndShade = 0
    End With
   
        Range("Tabella162425").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15382741
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
        Range("A1").Select
       
       
        For Each Cell In ActiveSheet.ListObjects("Tabella162425").ListColumns(1).DataBodyRange
I = I + 1: Cell.Offset(0, -1) = I
Next Cell
           
    Sheets("Foglio75").Select
    Application.ScreenUpdating = True

End Sub


Pensavo che magari potrebbe essere meno complicato ottenere il risultato che vorrei, se trasformassi la semplice ColonnaB in una colonna appartenente sempre alla Tabella162425.

Devo fare così?

Grazie
marte1503
Utente Senior
 
Post: 174
Iscritto il: 08/01/10 20:43
Località: Como

Re: [Excel] Macro per numerazione progressiva

Postdi Anthony47 » 08/01/12 09:44

Non hai apportato le modifiche che ti avevo detto qui: viewtopic.php?f=26&t=94093&p=538250#p538187

Ciao.
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Excel] Macro per numerazione progressiva

Postdi marte1503 » 08/01/12 20:51

Ciao Anthony,
solo per dirti che la macro funziona…
In questi gg sono stato costretto a provare sempre di fretta… In prima battuta ho letto la tua risposta
In seguito distrattamente sono tornato a copiare la vecchia macro..
Quando si prova una cosa bisognerebbe stargli addosso e non lavorarci a spizzichi e bocconi…
Grazie per la modifica!
Marte
marte1503
Utente Senior
 
Post: 174
Iscritto il: 08/01/10 20:43
Località: Como


Torna a Applicazioni Office Windows


Topic correlati a "[Excel] Macro per numerazione progressiva":


Chi c’è in linea

Visitano il forum: Nessuno e 8 ospiti