ELENCO FOGLI

Hai un problema con Excel?

Nuova discussione

ELENCO FOGLI
di alexpag1977 data: 20/08/2015 16:59:36
Salve, ho bisogno ancora di voi.....
ho un file con vari fogli in cui vengono inseriti degli ordini ed ho bisogno di riepilogare in un foglio riepilogo alcuni dati di questi ordini.
Mi avete consigliato un codice vba che funziona bene se non fosse che i nomi dei vari fogli non sono semplici ovvero contengono spazi e quindi non funziona la formula di riepilogo dandomi errore di riferimento.
vi allego il file dove funziona bene tutto ( essendo i nomi dei fogli molto semplici) e il file reale con i nomi dei fogli più lunghi.
inserisco anche il codice VBA che uso nel file semplice e che funziona
spero di essere stato chiaro

Private Sub Worksheet_Activate()
Range("O2:O" & Sheets.Count - 2).ClearContents
    For i = 2 To Sheets.Count - 1
        If Sheets(i).Name <> "riepilogo" Then
            Range("O" & i).Value = Sheets(i).Name
        End If
    Next i
End Sub

di Albatros54 data: 20/08/2015 17:50:22
Il problema sono gli spazi ,che ci sono tra le parole che danno il nome al foglio,
il codice funziona, sono le formule delle celle che non trovano riferimento,io ho provato a rinominare i fogli togliendo gli spazi, e tutto funziona.Il codice sotto
toglie gli spazi, è funziona, solo che devi togliere le parentesi dal nome dei fogli.

Private Sub Worksheet_Activate()
Range("O2:O" & Sheets.Count - 2).ClearContents
    For i = 2 To Sheets.Count - 1
        If Sheets(i).Name <> "riepilogo" Then
        Sheets(i).Name = Replace(Sheets(i).Name, " ", "")
            Range("O" & i).Value = Sheets(i).Name
        End If
    Next i
End Sub

di scossa data: 20/08/2015 18:42:43
Devi solo mettere, nelle formule, il nome del foglio tra apici:

=SE($O2="";"";INDIRETTO("'"&$O2&"'!"&INDIRIZZO(100;RIF.COLONNA(K$100))))

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 alexpag1977 data: 20/08/2015 19:34:48
il codice che togli gli spazi funziona benissimo grazie mille.....
ma mi è sorto un probleho anche una macro che mi ordina per codice in altro foglio riepilogo i pezzi ordinati da tutti i fogli della cartella e così facendo mi riporta anche quelli del riepilogo della riga 100.....
posto il codice della macro sperando che mi sono spiegato.
in sostanza vorrei 2 fogli riepilogo:
uno della riga 100
uno che riposrta ciascuna riga di ogni foglio ordinate per codice e per colore

Sub riepilogo()
Application.ScreenUpdating = False
r = Sheets("riepilogo ordinato").Range("b" & Rows.Count).End(xlUp).Row
For i = 2 To Sheets.Count - 1
    k = Sheets(i).Range("b2").End(xlDown).Row
    Sheets("riepilogo ordinato").Range("a" & r + 1 & ":z" & r + k - 1) = Sheets(i).Range("a2:Z" & k).Value
    r = r + k - 1
Next
Range("a2:Z" & r).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo
Application.ScreenUpdating = True
End Sub

di Raffaele_53 data: 20/08/2015 22:10:20
Da provare
Ps Leggo solo adesso colore, mà non capisco cosa intendi.
Pps ho usato il primo allegato a destra

Option Explicit
Sub riepilogoaccorpa2()
Dim ws As Worksheet, r As Long, k As Long, i As Long, arr, ce
Application.ScreenUpdating = False
Sheets("riepilogo ordinato").Select
'Sheets("riepilogo ordinato").Cells.ClearContents
r = Sheets("riepilogo ordinato").Range("b" & Rows.Count).End(xlUp).Row
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "NUOVO" And ws.Name <> "riepilogo" And ws.Name <> "riepilogo ordinato" Then
    With ws
        k = ws.Range("b2").End(xlDown).Row
        Sheets("riepilogo ordinato").Range("a" & r + 1 & ":y" & r + k - 1) = ws.Range("a2:y" & k).Value
        r = r + k - 1
    End With
    End If
Next ws
Sheets("riepilogo ordinato").Range("a2:y" & r).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo
For i = r To 2 Step -1
    If Cells(i, 2) = Cells(i - 1, 2) And Cells(i, 3) = Cells(i - 1, 3) And Cells(i, 4) = Cells(i - 1, 4) And Cells(i, 5) = Cells(i - 1, 5) And Cells(i, 6) = Cells(i - 1, 6) And Cells(i, 7) = Cells(i - 1, 7) And Cells(i, 8) = Cells(i - 1, 8) And Cells(i, 9) = Cells(i - 1, 9) And Cells(i, 10) = Cells(i - 1, 10) Then
         arr = Array(Cells(i, 11), Cells(i, 12), Cells(i, 13), Cells(i, 14), Cells(i, 15), Cells(i, 16), Cells(i, 17), Cells(i, 18), Cells(i, 19), Cells(i, 20), Cells(i, 21), Cells(i, 23), Cells(i, 24))
        For Each ce In arr
            If ce <> "" And ce <> " " Then
                ce.Offset(-1, 0) = ce.Offset(-1, 0) + ce.Value
            End If
        Next
        Rows(i).Delete
    End If
Next
MsgBox "fatto"
Application.ScreenUpdating = True
End Sub

di alexpag1977 data: 21/08/2015 17:55:30
Ciao Raffaele.....funziona benissimo il tuo codice......ti spiego cosa intenedevo per colore....
dopo aver usato la macro noterai che nel riepilogo ordinato ci sino i codici degli articoli, scorrendo sulla destra c'è il tessuto e poi il colore ecc....
se fosse possibile ordinare stesso codice,stesso tessuto, stesso colore,stesso contrasto.....
sarebbe il top....altrimenti lo farò manualmente con i filtri......

di alexpag1977 data: 21/08/2015 18:41:24
RAFFAELE SCUSA AGGIUNGENDO ALTRI FOGLI ED INOLTRE LA COLONNA Z NEL RIEPILOGO MI DA QUESTO ERRORE:
ce.Offset(-1, 0) = ce.Offset(-1, 0) + ce.Value

Option Explicit
Sub riepilogoaccorpa2()
Dim ws As Worksheet, r As Long, k As Long, i As Long, arr, ce
Application.ScreenUpdating = False
Sheets("riepilogo ordinato").Select
'Sheets("riepilogo ordinato").Cells.ClearContents
r = Sheets("riepilogo ordinato").Range("b" & Rows.Count).End(xlUp).Row
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "NUOVO" And ws.Name <> "riepilogo" And ws.Name <> "riepilogo ordinato" Then
    With ws
        k = ws.Range("b2").End(xlDown).Row
        Sheets("riepilogo ordinato").Range("a" & r + 1 & ":z" & r + k - 1) = ws.Range("a2:z" & k).Value
        r = r + k - 1
    End With
    End If
Next ws
Sheets("riepilogo ordinato").Range("a2:z" & r).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo
For i = r To 2 Step -1
    If Cells(i, 2) = Cells(i - 1, 2) And Cells(i, 3) = Cells(i - 1, 3) And Cells(i, 4) = Cells(i - 1, 4) And Cells(i, 5) = Cells(i - 1, 5) And Cells(i, 6) = Cells(i - 1, 6) And Cells(i, 7) = Cells(i - 1, 7) And Cells(i, 8) = Cells(i - 1, 8) And Cells(i, 9) = Cells(i - 1, 9) And Cells(i, 10) = Cells(i - 1, 10) Then
         arr = Array(Cells(i, 11), Cells(i, 12), Cells(i, 13), Cells(i, 14), Cells(i, 15), Cells(i, 16), Cells(i, 17), Cells(i, 18), Cells(i, 19), Cells(i, 20), Cells(i, 21), Cells(i, 23), Cells(i, 24))
        For Each ce In arr
            If ce <> "" And ce <> " " Then
                ce.Offset(-1, 0) = ce.Offset(-1, 0) + ce.Value
            End If
        Next
        Rows(i).Delete
    End If
Next
MsgBox "fatto"
Application.ScreenUpdating = True
End Sub

di Raffaele_53 data: 21/08/2015 22:10:20
Scusami...
Ho risposto per la faccenda >>>così facendo mi riporta anche quelli del riepilogo
Nel mio modo ci sono tre fogli che non vengono riportati. Poi sono andato oltre per vedere se funzionava anche il codice TUO.

Del fatto che non usi dichiarare le variabili, non posso farci nulla.
In alto ho dichiarato....

Option Explicit
Sub riepilogoaccorpa2()
Dim ws As Worksheet, r As Long, k As Long, i As Long, arr, ce

Mà come vedi Arr ed Ce non le ho dichiarate, perchè NON le capisco (di norma uso altri metodi forse più lenti)
Ora il foglio aggiunto, non provoca errore, rimane solo se aggiungi la colonna "X" (NON sò in quale foglio l'ho aggiungi? Devo ricreare tutte le possibilità, oppure dai più info?)

Ps Credo sia solo nella variabile "arr" e "ce"
Pps. Ripetere il mio codice nel post, serve solo a far scappare altri eventuale esperTi.
di alexpag1977 data: 22/08/2015 09:45:18
Ciao Raffaele.....scusami se non sono stato chiaro
le variabili sono che i fogli degli ordini aumenteranno, per il resto tutto va bene.
Cerco di spiegare meglio:
ogni foglio è un ordine di merce ( non so quanti saranno questi fogli)
il primo riepilogo è quello in cui mi riporta la riga 100 di ogni ordine ( e funziona benissimo)
il secondo riepilogo è quello che mi riporta tutte le righe di ciascun ordine ordinandole per codice,tessuto,colore contrasto ( adesso, nonostante mi di errore di debug funziona ma me li ordina solo per codice e non per tessuto,colore e contrasto)
allego il file su cui sto lavorando ( aggiungendo gli ordini)
se esegui la macro "accorpamento2" noterai che ordina per codice e non per tessuto,colore infatti scorrendo il primo codice 16A-503, tessuto albuca, colore nero albuca,nero albuca,verde albuca, rosso albuca, nero albuca ecc.
ecco vorrei che tutti i neri albuca siano di seguito e così gli altri colori.
spero di essermi spiegato stavolta e grazie ancora

di Raffaele_53 data: 22/08/2015 13:21:16
>>>nonostante mi di errore di debug.....ce.Offset(-1, 0) = ce.Offset(-1, 0).Value + ce.Value
Siamo alla riga 337 e noterai che in cella K336 c'è uno spazio. Da togliere, si però devi anche trovarlo nel foglio originale
Idem in riga 288 e in K287 c'è uno spazio. Da togliere, si però devi anche trovarlo nel foglio originale

>>>me li ordina solo per codice e non per tessuto,colore e contrasto
Tu hai scritto >>>Sheets("riepilogo ordinato").Range("a2:y" & r).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo

Ps. ho aumentato l'ordine sino alla colonna AA, spero sia quello il problema de aggiungere colonne, altrimenti devi rivedere quello che associ ad arr
>>>per tessuto,colore e contrasto
Se ho capito sarebbe...

Option Explicit
Sub riepilogoaccorpa2()
Dim sh1 As Worksheet: Set sh1 = Worksheets("riepilogo ordinato") ' da cambiare casomai
Dim ws As Worksheet, r As Long, k As Long, i As Long, Ur As Long, arr, ce
Application.ScreenUpdating = False
'ws1.Cells.ClearContents
r = sh1.Range("b" & Rows.Count).End(xlUp).Row
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "NUOVO" And ws.Name <> "riepilogo" And ws.Name <> "riepilogo ordinato" Then
    With ws
        k = ws.Range("b2").End(xlDown).Row
        sh1.Range("a" & r + 1 & ":z" & r + k - 1) = ws.Range("a2:z" & k).Value
        r = r + k - 1
    End With
    End If
Next ws
For i = r To 2 Step -1
    If Cells(i, 2) = Cells(i - 1, 2) And Cells(i, 3) = Cells(i - 1, 3) And Cells(i, 4) = Cells(i - 1, 4) And Cells(i, 5) = Cells(i - 1, 5) And Cells(i, 6) = Cells(i - 1, 6) And Cells(i, 7) = Cells(i - 1, 7) And Cells(i, 8) = Cells(i - 1, 8) And Cells(i, 9) = Cells(i - 1, 9) And Cells(i, 10) = Cells(i - 1, 10) Then
         arr = Array(Cells(i, 11), Cells(i, 12), Cells(i, 13), Cells(i, 14), Cells(i, 15), Cells(i, 16), Cells(i, 17), Cells(i, 18), Cells(i, 19), Cells(i, 20), Cells(i, 21), Cells(i, 23), Cells(i, 24))
        For Each ce In arr
            If ce <> "" And ce <> " " Then
                ce.Offset(-1, 0) = ce.Offset(-1, 0).Value + ce.Value
            End If
        Next
        Rows(i).Delete
    End If
Next i
Ur = sh1.Range("A" & Rows.Count).End(xlUp).Row
    sh1.Sort.SortFields.Clear
    sh1.Sort.SortFields.Add Key:=Range("G2:G" & Ur), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    sh1.Sort.SortFields.Add Key:=Range("H2:H" & Ur), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    sh1.Sort.SortFields.Add Key:=Range("I2:I" & Ur), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With sh1.Sort
        .SetRange Range("A1:AA" & Ur)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
MsgBox "fatto"
Application.ScreenUpdating = True
Set sh1 = Nothing
End Sub

di alexpag1977 data: 23/08/2015 10:43:25
Ho tolto gli spazi nella colonna K ma comunque mi da errore di debug.....ma visto che funziona tutto mi tengo l'errore e la uso così....grazie mille Raffaele....
di Vecchio Frac data: 23/08/2015 11:57:20
cit. "mi da errore di debug"
---> Affermazione priva di senso... non esiste un "errore di debug", il debug è un'attività che consiste nel cercare e rimuovere gli errori del programma. Il sistema se segnala una condizione di errore che interrompe l'esecuzione, chiede un intervento del programmatore comunicandogli un codice di errore, una sua descrizione e fermandosi sulla riga di codice che ha generato l'interruzione. Sorvolando sulla coerenza delle traduzioni di codici di errore in italiano, quando incontri un problema che interrompe il programma, il codice di errore è generalmente sufficiente a dirti cosa è andato storto. Di solito basta il riferimento all'errore per capire come intervenire. Pertanto se vuoi un aiuto concreto non devi limitarti a dire che si è verificato un errore, ma devi riportare il codice dell'errore, la sua descrizione e la riga su cui l'esecuzione si è interrotta. Inoltre è generalmente sbagliato arrendersi: non è una buona prassi affermare che "visto che funziona tutto mi tengo l'errore e la uso così". Prima o poi salta fuori qualche accumulo di errori che invalida il risultato stesso dell'operazione.
di alexpag1977 data: 24/08/2015 13:39:21
Ciao Vecchio Frac....hai ragione mai arrendersi, ma essendo io un incapace sui codici vba, cerco di utilizzare al meglio i codici che mi consigliate....( un grazie speciale a Raffaele)....
l'errore che mi da è questo:
errore di run-time 13
tipo non corrispondente
dopo cliccando in debug mi evidenzia questa riga del codice vba:
ce.Offset(-1, 0) = ce.Offset(-1, 0) + ce.Value
spero di essermi spiegato
allego immagine dell'errore
di Raffaele_53 data: 24/08/2015 16:49:19
Quando appare un errore, bisogna capire il motivo.
Quando Ti appare la maschera hai due tasti FINE o DEBUG

Se premi FINE esci e il codice non ha terminato.

Se premi DEBUG visualizzi la stringa. Sul file "Ordini 2016", avvii la macro=ERRORE, premo debug...se vado col mouse sopra >>>Rows(i).Delete vedrai che è fermo alla riga 337. Siccome il quel istante il codice cercava di sommare la riga precedente K336:U337 bisogna capire il perchè. Ho detto togli lo spazio alla cella K336, si però noto pure che c'è un'altro spazio in L336 dopo controlli anche le altre colonne se ci fossero altri spazi. Adesso riavvia il codice finchè non Ti darà più nessun errore.

Oppure selezioni le colonne K:U e premi tasto TROVA/Sostituisci Spazio con nulla.
Mà Tutto questo non serve a nulla dato che i spazi sono negli altri fogli.
Vai in OGNI foglio selezioni le colonne K:U e premi tasto TROVA/Sostituisci Spazio con nulla.
di alexpag1977 data: 24/08/2015 18:19:48
Ciao Raffaele.....adesso ho capito.....almeno per quanto riguarda l'errore di debug.....ho tolto tutti gli spazi nei fogli e funziona
adesso però non fuonziona l'ordinamento ( e non accorpamento) per codice,tessuto,colore, contrasto.....sono queste le uniche colonne da immettere nel codice ( colonna B, G, H ,I) da ordinare.
mi da questo errore quando eseguo la macro:
errore di compilazione
variabile non definita

mi evidenzia sh1 dopo next i
allego il file

di alexpag1977 data: 24/08/2015 18:32:55
Raffaele scusami.....sono un disastro, non ci sto capendo quasi più niente......mi sono accorto adesso che praticamente la macro "accorpamento2" mi somma i prodotti con stessi codici e non me li ordina semplicemente

praticamente stiamo lavorando sulla macro sbagliata......non è la macro "accorpamento" da usare ma la macro "riepilogo".
che casino....spero di essermi spiegato e ti chiedo umilmente scusa.
ho provato a fare qualcosa di osceno.....cioè registrando la macro e copiando il codice vba.
sembra funzioni così ( ovviamente fino alla riga 50000)
non so se si pùò migliorare.....

Option Explicit
Sub riepilogoalex()
Dim ws As Worksheet, r As Long, k As Long, i As Long, arr, ce
Application.ScreenUpdating = False
Sheets("riepilogo ordinato").Select
'Sheets("riepilogo ordinato").Cells.ClearContents
r = Sheets("riepilogo ordinato").Range("b" & Rows.Count).End(xlUp).Row
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "NUOVO" And ws.Name <> "riepilogo" And ws.Name <> "riepilogo ordinato" Then
    With ws
        k = ws.Range("b2").End(xlDown).Row
        Sheets("riepilogo ordinato").Range("a" & r + 1 & ":z" & r + k - 1) = ws.Range("a2:z" & k).Value
        r = r + k - 1
    End With
    End If
Next
 ActiveWorkbook.Worksheets("riepilogo ordinato").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("riepilogo ordinato").Sort.SortFields.Add Key:= _
        Range("B2:B50000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("riepilogo ordinato").Sort.SortFields.Add Key:= _
        Range("G2:G50000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("riepilogo ordinato").Sort.SortFields.Add Key:= _
        Range("H2:H50000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("riepilogo ordinato").Sort.SortFields.Add Key:= _
        Range("I2:I50000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("riepilogo ordinato").Sort
        .SetRange Range("A1:Z50000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
MsgBox "fatto"
Application.ScreenUpdating = True
End Sub

di Raffaele_53 data: 24/08/2015 22:28:26
>>>adesso però non fuonziona l'ordinamento ( e non accorpamento)
Giuro che non capisco.

Non ci sono più errori di codice. OK
OK.Adesso devo capire l'ordinamento

>>>le uniche colonne da immettere nel codice ( colonna B, G, H ,I) da ordinare.
>>>ordinare stesso codice,stesso tessuto, stesso colore,stesso contrasto...

In effetti mi sono mangiato la prima opzione=stesso codice.....colonna B

Lascia perdere il Tuo codice errato, prova ad inserire nel mio dopo questa riga>>>sh1.Sort.SortFields.Clear

sh1.Sort.SortFields.Add Key:=Range("B2:B" & Ur), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

Se non funziona sposta l'allegato in modo da vederlo
di alexpag1977 data: 24/08/2015 23:42:12
Raffaele sei un mito......ho aggiunto la riga che mi hai indicato e funziona tutto alla grande.....
ti ringrazio infinitamente e ringrazio tutto lo staff del forum.....siete grandi

Vuoi Approfondire?