Creazione elenco da tabella

[Venerdi]

Ciao a tutti, sono un vecchio utente, che, dopo parecchio, ha nuovamente bisogno del vs. aiuto.
La questione è stata già trattata nel forum, ma purtroppo, non riesco ad adattare alle mie necessità ciò che ho trovato.
Allego un file con all'interno due fogli. Nel primo c'è la partenza (Tabella); nel secondo il risultato che devo ottenere (Output). Ovviamente è un esempio; nella realtà i numeri sono decisamente maggiori.
http://www.filedropper.com/abm
In sostanza devo trovarmi nel foglio "Output" le celle delle colonne "Et*" ripetute, con vicino la città (o cmq il nome dell'intestazione delle colonne), per tante righe quanto indicano i numeri.
Le colonne etichetta ritengo non mi varieranno (a livello di quantità). Le colonne delle città, invece potrebbero.
Sperando di essere stato chiaro ...attendo un vs gentile aiuto.



grazie
v.

[Anthony47]

Direi che puoi ottenere qualcosa usando questa macro:

Codice: Seleziona tutto

Sub sabato()
Dim oSh As Worksheet, I As Long, J As Long, LastR As Long
Dim Rip As Variant
'
Sheets("Tabella").Select
Set oSh = Sheets("Output")
oSh.Range("A2").Resize(1000, 100).ClearContents
LastR = getLast
For I = 2 To LastR
'        Cells(I, 10).Select

        For J = 11 To Cells(1, Columns.Count).End(xlToLeft).Column
'            Selection.Offset(0, 1).Select
            Rip = Cells(I, J).Value
            If Rip <> "" Then
                mynext = oSh.Cells(Rows.Count, 1).End(xlUp).Row + 1
                Cells(I, 1).Resize(1, 10).Copy oSh.Cells(mynext, 1).Resize(Rip, 1)
                oSh.Cells(mynext, 11).Resize(Rip, 1).Value = Cells(1, J).Value
            End If
        Next J
Next I
Cells(1, 1).Select
End Sub

Ciao

[Venerdi]

Grazie, nel pomeriggio la provo.
V.

[Venerdi]

No, non va.
Non fa assolutamente nulla... forse perchè l'hai denominata sabato(), e il sabato non si lavora

[Anthony47]

Ma oltre ad averla inserita l'hai anche eseguita?
Comunqu io l'ho provata sul file che hai pubblicato, prova anche tu allo stesso modo; e se non va pubblica il tuo file con le tue prove.

Ciao

[Venerdi]

Certo che l'ho eseguita.
Metto l'upload del file con la macro attivata.
http://www.filedropper.com/abmconmacro
Se la lancio, non accade nulla; nel foglio "output" non mi scrive niente.
Ho altre macro, vanno tutte.
ciao
v

[Anthony47]

Ah ha, la macro funziona... pero' si appoggia sulla funzione GetLast il cui codice non te l'avevo scritto!
Aggiungi questa nel modulo in cui hai inserito la Sub sabato:

Codice: Seleziona tutto

Function getLast() As Long
Dim LastR As Long
On Error Resume Next
LastR = Cells.Find(What:="*", After:=[A1], _
              SearchOrder:=xlByRows, _
              SearchDirection:=xlPrevious).Row
On Error GoTo 0
getLast = LastR
End Function


Ciao.

[Venerdi]

In che punto devo inserire l'aggiunta?
Se la metto nello stesso modulo, alla fine dopo End Sub, non l'accetta.
Se sposto End Sub alla fine di tutte e due, mi dà errore ugualmente...
ciao

[Anthony47]

Hummm....
Sono andato su Modulo1 del tuo file e ho aggiunto il nuovo codice in coda al preesistente:

invia immaginicertificity.com
Lanciata la Sub sabato ho compilato Output senza problemi.

Puoi essere piu' dettagliato nello spiegare quello che fai e quello che ti succede?

Ciao

[Venerdi]

Ho scoperto cosa c'è che non va... (peraltro, prima avevo sbagliato io qualcosa).
La macro si ferma e va in Debug su questa istruzione:

Cells(I, 1).Resize(1, 10).Copy oSh.Cells(mynext, 1).Resize(Rip, 1)

Questo avviene solo quando deve essere elaborata una cella che contiene il valore 0 (zero)
Se la cella è semplicemente vuota, non ci sono problemi, la salta, ma se la trova valorizzata con il nemero zero scritto in cifra, si ferma.

Se mi prendo la briga di pulire, togliendo tutti gli zeri, funziona perfettamente e velocemente...
...e di questo ti ringrazio.
ciao

[Anthony47]

Beh, se le celle sono compilate a mano allora a mano andrebbero tolti gli Zero.

Comunque bastera' modificare la riga If Rip <> "" Then in

Codice: Seleziona tutto

If Rip > 0 Then

Ciao

[Venerdi]

La macro funziona alla perfezione. Grazie.
In molte macro ho inserito un timer con il codice che ti riporto sotto.
Su questa, probabilmente per la presenza della funzione GetLast, dà la macro per terminata quasi subito, mentre in effetti continua a scrivere.
C'è modo d'inserirlo in maniera che funzioni, oppure no?
Ovviamente è una questione più estetica che sostanziale, quindi non particolarmente importante.

Codice: Seleziona tutto

Dim D1, D2 As Date
         Dim tempoimpiegato As String
         D1 = Time

*********************************


D2 = Time
    tempoimpiegato = Format(D2 - D1, "hh:mm:ss")
    MsgBox "Esecuzione Terminata - Tempo impiegato: " & tempoimpiegato

End Sub


[Anthony47]

Da come la racconti mi viene il sospetto che la prima parte l'hai scritta in testa alla Sub Sabato, la seconda in coda alla Function getLast...
Devi invece mettere anche questa seconda parte all'interno della Sub Sabato, subito prima della sua End Sub.

Ciao

[Venerdi]

No, la fine l'ho messa prima di End Sub.
...in effetti ho provato in entrambi i modi
ciao

[Anthony47]

No, la fine l'ho messa prima di End Sub.

Allora il messaggio compare subito prima che la macro termini; invece di usare Time (che ti da una precisione al secondo) usa Timer, che ti da una precisione al centesimo di secondo:
1) In testa:

Codice: Seleziona tutto

Dim D1 As Single
D1 = Timer

2) in coda

Codice: Seleziona tutto

MsgBox ("Terminato in (sec): " & Format(Timer - D1, "0.00"))
End Sub

Ciao

[Venerdi]

...un grazie grandissimo; tutto OK
Un'ultimissima domanda.
Si può modificare il formato del timer, e invece di secondi e centesimi, avere minuti, secondi e centesimi?
ciao
V.

[Anthony47]

Secondo me non ha senso rappresentare "centesimi di secondo" se la scala e' di "minuti"; se proprio vuoi, puoi differenziare il messaggio a seconda del tempo trascorso. Esempio:

Codice: Seleziona tutto

'In testa:
Dim myTim As Single, Elaps As Single
myTim = Timer
'
'il resto della macro
'
'In coda:
Elaps = Timer - myTim
If Elaps < 30 Then
    MsgBox ("Completato in (sec) " & Format(Elaps, "0.00"))
Else
    MsgBox ("Completato in (hh:mm:ss) " & Format(Elaps / 86400, "hh:mm:ss"))
End If
End Sub


In questo modo fino a 30 sec scrivi es 25,10 ma oltre scrivi 00:12:33
Tieni presente che l'uso del timer come scritto presuppone che inizio e fine stiano nella stessa giornata.

Ciao

[Venerdi]

Grazie e ...al prossimo thread