Stellar Blade Un'esclusiva PS5 che sta facendo discutere per l'eccessiva bellezza della protagonista. Vieni a parlarne su Award & Oscar!

Excel Forum Per condividere esperienze su Microsoft Excel

Modifica numero foglio di lavoro quando supero 100

  • Messaggi
  • OFFLINE
    BG66
    Post: 343
    Registrato il: 13/12/2015
    Città: MILANO
    Età: 58
    Utente Senior
    2010
    00 23/04/2021 15:38
    Ciao a tutti.
    Premetto che è solo una curiosità accademica.
    In pratica in questo script: 
     Sub numera() 
Dim prev() 
Dim sh As Worksheet 
ReDim Preserve prev(Worksheets.Count) 
Max = 0 
For i = 1 To Worksheets.Count     
           prev(i) = Split(Worksheets(i).Name, "21-10") 'fino a 100 usare ->21-0 dopo 21-10     
           On Error Resume Next     
           If prev(i)(1) > Max Then Max = prev(i)(1)     
           On Error GoTo 0 
Next i 
Max = Max + 1 Worksheets("master (2)").Name = "21-10" & Max 'fino a 100 usare ->21-0 dopo 21-10 
Call EstraiNomeFoglio 
End Sub


    Da 21-001 a 21-099 -> uso: 
     ...............   
           prev(i) = Split(Worksheets(i).Name, "21-0")     
           ............
           Max = Max + 1 Worksheets("master (2)").Name = "21-0" & Max 
           .............


    Successivamente per avere il foglio numerato da 21-100 fino a 21-999 effettuo una correzione manuale dello script: 
     ...............   
           prev(i) = Split(Worksheets(i).Name, "21-10")     
           ............
           Max = Max + 1 Worksheets("master (2)").Name = "21-10" & Max 
           .............


    Ma se volessi evitarla?
    PS i primi due numeri indicano l'anno in corso.

    Grazie per l'aiuto.
    [Modificato da BG66 23/04/2021 15:41]
    BG66
    Excel 2010
  • OFFLINE
    dodo47
    Post: 3.149
    Registrato il: 06/04/2013
    Utente Master
    2010
    00 23/04/2021 16:27
    ciao

    magari una spiegazione per vecchietti???

    saluti



    Domenico
    Win 10 - Excel 2016
  • OFFLINE
    BG66
    Post: 343
    Registrato il: 13/12/2015
    Città: MILANO
    Età: 58
    Utente Senior
    2010
    00 23/04/2021 16:42
    Ciao Domenico,
    lo sai che la mia fiducia nelle capacità divinatorie di chi frequenta questo forum è altissima!! 😀

    In pratica, ho un file che dopo una serie di elaborazioni arriva a creare un foglio master (2) partendo da uno schema iniziale.
    Successivamente con lo script sopracitato vado a rinominare il foglio in maniera progressiva.
    Il tutto funziona alla perfezione. Ma siccome non riesco a "stare fermo" ho provato a ragionare su come evitare l'operazione amanuense di correggere lo script quando i fogli di lavoro arrivano a 100.

    Non ho allegato il file perchè cancellando tutti i dati sensibili mi sono ritrovato con un foglio bianco che creava un foglio bianco... ma se pensi sia d'aiuto posso allegarlo comunque.

    Gene
    [Modificato da BG66 23/04/2021 16:44]
    BG66
    Excel 2010
  • OFFLINE
    Marius44
    Post: 906
    Registrato il: 24/06/2015
    Città: CATANIA
    Età: 80
    Utente Senior
    Excel2019
    00 23/04/2021 17:55
    Salve a tutti

    Non dici come sono denominati i fogli ma credo che facendo lo split non con "21-00" ma con "-" avrai prev(i)(0) che sarà uguale da "21", quindi aggiungi la lineetta e continui col max fini a quando vuoi. Cioè
    ...............
    prev(i) = Split(Worksheets(i).Name, "-")
    ............
    Max = Max + 1 Worksheets("master (2)").Name = prev(0) & "-" & Max
    .............


    Ciao,
    Mario

    PS - Ovviamente questa è l'idea. Se poi vuoi 3 cifre dopo la lineetta occorre costruire il dato, ma è facile.
    [Modificato da Marius44 23/04/2021 21:10]
  • ABCDEF@Excel
    00 23/04/2021 22:34
    Solo se ho capito. Ex... 
    Sub numera2()
Dim N As Long, A As String
A = "21-" ' Anno ed -
N = Worksheets.Count + 1
    Sheets("master").Copy After:=Sheets(Sheets.Count)
    If N < 10 Then
        ActiveSheet.Name = A & Format(N, "0")
    ElseIf N < 100 Then
        ActiveSheet.Name = A & Format(N, "00")
    ElseIf N < 1000 Then
        ActiveSheet.Name = A & Format(N, "000")
    End If
End Sub

    Forse desideri solo ...00 & 000
        If N < 100 Then
        ActiveSheet.Name = A & Format(N, "00")
    ElseIf N < 1000 Then
        ActiveSheet.Name = A & Format(N, "000")
    End If
    [Modificato da ABCDEF@Excel 24/04/2021 11:13]
  • OFFLINE
    BG66
    Post: 344
    Registrato il: 13/12/2015
    Città: MILANO
    Età: 58
    Utente Senior
    2010
    00 24/04/2021 21:57
    Ciao a tutti.
    Scusate il ritardo nella risposta ma ho provato ad integrare il suggerimento di Mario con lo script di ABCDEF@Excel con l'obiettivo (non raggiunto 😡) di avere le tre cifre dopo il trattino.
    Infatti lo script di @ABCDEF@Excel numera il foglio nuovo contando quelli esistenti e inserendolo in coda mentre la modifica di Mario "tocca" solo il nome del foglio lasciando immutate le altre peculiarità (numerazione escludendo alcuni fogli, posizionamento foglio e eliminazione del foglio master (2).
    Al momento l'unica mia integrazione è stata questa: 
    -----------
prev(i) = Split(Worksheets(i).Name, "21-") 'by Marius     
--------
Worksheets("master (2)").Name = prev(0) & "21-" & Max 'by Marius


    Allego file depurato. Principio di funzionamento:
    Premo IMPORTA nel foglio "master" creo master (2) e in questo foglio uso Numera per rinominarlo (21-001, etc, 21-100, etc, etc)

    PS L'errore 91 non si presenta nel file originale ma credo che sia frutto della "pulizia" dei dati sensibili quindi ho scelto di ignorarne la causa!!

    Grazie per l'aiuto
    BG66
    Excel 2010
  • OFFLINE
    Marius44
    Post: 907
    Registrato il: 24/06/2015
    Città: CATANIA
    Età: 80
    Utente Senior
    Excel2019
    00 24/04/2021 23:12
    Ciao Gene

    1°) evita di usare per le variabili definizioni riservate (di Excel o VBA), per esempio Max. Io ho messo mx
    2°) questa la macro dove, alla fine troverai uno Stop per farti notare che la variabile nomefoglio riporta il numero successivo 
    Sub numera()
Dim i As Long
Dim mx As Integer
Dim nomefoglio As String
Dim prev
Dim sh As Worksheet
mx = 0
For i = 1 To Worksheets.Count
    On Error Resume Next
    If Left(Worksheets(i).Name, 3) = "21-" Then
      prev = Split(Worksheets(i).Name, "-") 'by Marius
    End If
    On Error GoTo 0
Next i
mx = Val(prev(1)) + 1
'QUI ASSEGNI IL NOME DEL NUOVO FOGLIO DOPO AVER CREATO LE TRE CIFRE
nomefoglio = prev(0) & "-" & Right("000" & mx, 3)
Stop
Call EstraiNomeFoglio
End Sub

    Quando si ferma la macro se ti posizioni "sopra" la variabile nomefoglio vedrai il nome da assegnare.
    Non vedo, però, come crei il nuovo foglio.
    Buona Domenica,
    Mario
  • OFFLINE
    Marius44
    Post: 908
    Registrato il: 24/06/2015
    Città: CATANIA
    Età: 80
    Utente Senior
    Excel2019
    00 25/04/2021 07:10
    Buongiorno

    @BG66
    Gene attento che la macro di cui sopra funziona se i Fogli sono in sequenza e, quindi, l'ultimo foglio porta il numero maggiore. Se i Fogli fossero disposti diversamente occorre una piccola modifica che, sono certo, sei in grado di applicare.

    Ciao,
    Mario
  • OFFLINE
    BG66
    Post: 345
    Registrato il: 13/12/2015
    Città: MILANO
    Età: 58
    Utente Senior
    2010
    00 25/04/2021 07:52
    Ciao Mario,
    non riesco a capire..
    In pratica allo stop mi visualizza correttamente il dato atteso ma quando riprende non lo esegue (??!!)
    Ho anche avuto il dubbio letta la tua nota sull'ultimo foglio che dovessi forzargli la mano creando ex-novo il preventivo 21-001 e poi lanciando lo script ma non ha funzionato comunque. In pratica nessun avviso/errore ma il foglio non viene rinominato.
    Ho escluso invece la possibilità che il foglio sia posizionato nella seguenza sbagliata proprio perchè il numero indicato allo STOP è corretto!!


    Grazie per l'aiuto
    Gene

    [Modificato da BG66 25/04/2021 07:57]
    BG66
    Excel 2010
  • OFFLINE
    dodo47
    Post: 3.151
    Registrato il: 06/04/2013
    Utente Master
    2010
    20 25/04/2021 10:18
    @BG
    Se ho capito devi duplicare il foglio "master" assegnandogli come nome anno-progressivo a tre cifre, qualora un foglio non esistesse già il nome sarà 21-001, altrimenti 21-002 , 3 , etc etc

    1) suggerisco di spostare tutti i fogli aggiunti alla fine, quindi dopo storico 2020, in modo da averli in progressione

    2) NB: se hai per esempio i fogli 21-001 e 21-003 (perchè 21-002 lo hai eliminato), il foglio creato sarà 21-004

    3) infine suggerisco di lasciare il pulsante che genera il nuovo foglio SOLO sul foglio master (almeno io la penso così)

    4) ho lasciato solo il pulsante legato alla mia routine che trovi nel modulo Domenico

    5) a tale pulsante ho assegnato nome "NewS" per poterlo eliminare dal foglio creato

    saluti 

    Sub InsFoglio()
Dim CurYear As String, mMaster As Worksheet, j As Integer, arrNumb(), mSheet As String
Set mMaster = Worksheets("master")
CurYear = "21" ' <<< eventualmente prendi valore da cella di Master (?)
k = 0
' cerco eventuale ultimo foglio
For j = 1 To Sheets.Count
    If Left(Sheets(j).Name, 2) = CurYear Then
        ReDim Preserve arrNumb(k)
        mpos = 4
        arrNumb(k) = Mid(Sheets(j).Name, mpos, Len(Sheets(j).Name)) * 1
        k = k + 1
    End If
Next j
' se già non esiste creo 001, altrimenti incremento
If k > 0 Then
    mMax = WorksheetFunction.Max(arrNumb) + 1
Else
    mMax = 1
End If
mSheet = CurYear & "-" & Format(mMax, "000")
mMaster.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = mSheet
'cancello pulsante comando nel foglio creato
ActiveSheet.Shapes("NewS").Delete
End Sub




    [Modificato da dodo47 25/04/2021 10:22]
    Domenico
    Win 10 - Excel 2016
  • OFFLINE
    BG66
    Post: 346
    Registrato il: 13/12/2015
    Città: MILANO
    Età: 58
    Utente Senior
    2010
    00 25/04/2021 14:18
    Ciao Domenico,
    è quasi perfetto.
    Ho apprezzato il tuo suggerimento e ho creato il collegamento alla data in corso in questo modo: 
     CurYear = Format(mMaster.Range("AC35"), "yy")


    Mentre vorrei poter modificare la progressione in modo da avere l'ultimo preventivo dopo il foglio sommario e dal più grande a decrescere.

    Grazie se puoi.
    Gene
    [Modificato da BG66 25/04/2021 14:19]
    BG66
    Excel 2010
  • OFFLINE
    dodo47
    Post: 3.152
    Registrato il: 06/04/2013
    Utente Master
    2010
    10 25/04/2021 16:48
    ciao
    quindi tra sommario e config.....
    te lo preciso perchè "config" serve per riferimento quando non c'è nessun foglio aggiunto.
    Se non è così dovremo fare un doppio copy uno before e uno after, fai sapere 

    Option Explicit

Sub InsFoglio()
Dim CurYear As String, mMaster As Worksheet, j As Integer, arrNumb(), mSheet As String
Dim mBefore As String, k As Integer, mPos As Byte, mMax As Integer
On Error GoTo errori
Application.Calculation = xlCalculationManual
Set mMaster = Worksheets("master")
CurYear = Format(mMaster.Range("AC35"), "yy")
k = 0
' cerco eventuale ultimo foglio
For j = 1 To Sheets.Count
    If Left(Sheets(j).Name, 2) = CurYear Then
        ReDim Preserve arrNumb(k)
        mPos = 4
        arrNumb(k) = Mid(Sheets(j).Name, mPos, Len(Sheets(j).Name)) * 1
        k = k + 1
    End If
Next j
' creo nome progressivo destinazione e variabile foglio prima del quale va inserito
If k > 0 Then
    mMax = WorksheetFunction.Max(arrNumb) + 1
    mBefore = CurYear & "-" & Format(mMax - 1, "000")
Else
    mMax = 1
    mBefore = "Config"
End If
mSheet = CurYear & "-" & Format(mMax, "000")
mMaster.Copy before:=Sheets(mBefore)
ActiveSheet.Name = mSheet
'cancello pulsante comando nel foglio creato
ActiveSheet.Shapes("NewS").Delete
Application.Calculation = xlCalculationAutomatic
esci:
Exit Sub

errori:
MsgBox Err.Number & " - " & Err.Description
Resume esci
End Sub


    saluti


    EDIT: qualora vi fossero eventi ti suggerisco di disattivarli ad inizio e riattivarli alla fine
    [Modificato da dodo47 25/04/2021 17:04]
    Domenico
    Win 10 - Excel 2016
  • OFFLINE
    BG66
    Post: 347
    Registrato il: 13/12/2015
    Città: MILANO
    Età: 58
    Utente Senior
    2010
    00 25/04/2021 17:56
    [RISOLTO]
    Ciao Domenico,
    tutto perfetto.

    Grazie e buona domenica.
    Gene
    STAY SAFE
    BG66
    Excel 2010
  • OFFLINE
    dodo47
    Post: 3.153
    Registrato il: 06/04/2013
    Utente Master
    2010
    00 26/04/2021 10:12
    Gene
    la label di rimando

    esci:

    deve essere posta prima di:
    Application.Calculation = xlCalculationAutomatic

    quindi: 
    ......
.....
ActiveSheet.Shapes("NewS").Delete

esci:
Application.Calculation = xlCalculationAutomatic
Exit Sub
errori:
MsgBox Err.Number & " - " & Err.Description
Resume esci
End Sub


    Altrimenti in caso di errore ti resta il calcolo manuale

    sorry.....
    saluti





    Domenico
    Win 10 - Excel 2016
  • 15MediaObject5,00314 3
Soluzioni Excel Domande e Risposte
Passa alla versione desktop

  • Anteprima