Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Trasporre "dinamico"

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

Trasporre "dinamico"

Postdi Gianca532011 » 25/01/19 14:34

Ciao a tutti,
questo è il problema : scarico dati da un sito ad ogni minuto: Ne copio una colonna in automatico su un secondo foglio " storico" e fin qui tutto bene, ora vorrei che solo le righe contrassegnate con X vadano in un " foglio2" ma con progressione automatica e in colonna. Ho provato con varie macro qua e la scaricate, ma stante la mia pochezza in VBA, ho grosse difficoltà a sistemarle, ma anche a capire la logica da usare . :oops:
Grazie a chi vorrà dedicarmi un po' del suo tempo.
Ps nei moduli 5 e 6 trovate my experiment, non ridere prego :D

Allego il file

http://www.filedropper.com/04aazioniitaautostorico
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 258
Iscritto il: 27/05/11 10:18

Sponsor
 

Re: Trasporre "dinamico"

Postdi Anthony47 » 26/01/19 02:09

Non sono i tentativi non riusciti che mi fanno sorridere quanto i tentativi non tentati che mi fanno incavolare...

Cio' detto, mi pare che tu hai la Copiaweb che parte ogni minuto e importa da web, e a questa si accodano la Sub Ordina e la Sub CopyValues.
Andiamo in coda alla Sub CopyValues, dove al posto di "mCopia" (che quindi puo' essere eliminata) inseriamo:

Codice: Seleziona tutto
Dim I As Long, ShSt As Worksheet, ShX As Worksheet, lastC As Long, cIcs As Long
'
Set ShSt = Sheets("Storico")                              '<<< Il foglio coi dati da copiare
Set ShX = Sheets("Foglio2")                               '<<< Il foglio su cui copiare
lastC = ShSt.Cells(1, Columns.Count).End(xlToLeft).Column
ShX.Range("A3").CurrentRegion.ClearContents         'AZZERA su Foglio2 l'area da A3 verso dx /il basso
With ShSt
    .Range(.Cells(1, "C"), .Cells(1, lastC)).Copy
    ShX.Range("A3").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, , True
    For I = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
        If UCase(ShSt.Cells(I, 1)) = "X" Then
            cIcs = cIcs + 1
            .Range(.Cells(I, 2), .Cells(I, lastC)).Copy
            ShX.Range("A2").Offset(0, cIcs).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, , True
        End If
    Next I
End With
Application.CutCopyMode = False
'mCopia
    Sheets("Azioni_ITA").Protect                    'GIA' PRESENTE
End Sub                                             'GIA' PRESENTE

Le istruzioni Dim puoi posizionarle in cima alla Sub, dove normalmente (per convenzione) si trovano le dichiarazioni.

Il codice aggiunto:
-imposta un riferimento ai fogli Storico e Foglio2
-CANCELLA SENZA PREAVVISO su Foglio2 l'area contigua che si trova da A2 verso destra e verso il basso (sara' cancellata l'area fintanto che non si trova una riga in basso e una colonna a destra totalmente vuota)
-scorre le righe di Storico, e quelle che hanno in colonna A una X vengono copiate, trasponendole in verticale, su Foglio2; vengono copiati sia i nomi dei titoli che tutte le quotazioni.
-in colonna A di Foglio2 viene copiato il contenuto di Riga1 di Storico, cioe' data /ora di importazione

La macro non si occupa di formattare Foglio2, e' possibile che qualche campo debba essere formattato manualmente al primo utilizzo

Prova e fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 17656
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Trasporre "dinamico"

Postdi Gianca532011 » 26/01/19 09:45

Grazie Anthony, sembra funzionare perfettamente, ma lo verificherò meglio lunedi con i dati reali.

Ti chiedo invece due minuti per dare un occhio alla mia "interpretazione" del codice da te postato.

Set ShSt = Sheets("Storico") '<<< Il foglio coi dati da copiare
Set ShX = Sheets("Foglio2") '<<< Il foglio su cui copiare

lastC = ShSt.Cells(1, Columns.Count).End(xlToLeft).Column
‘ ultima colonna= su fo” storico”( a partire dalla riga 1, conta colonne dal fondo verso sx) , ottengo il riferimento di colonna

ShX.Range("A3").CurrentRegion.ClearContents 'AZZERA su Foglio2 l'area da A3 verso dx /il basso

With ShSt ‘ su foglio “Storico”
.Range(.Cells(1, "C"), .Cells(1, lastC)).Copy
‘ range (da cella (riga1 ,Colonna C) a cella (riga1 ,ultima colonna ) copia

ShX.Range("A3").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, , True
‘ su foglio2 , a cominciare dal range A3 , incolla speciale, valori, penso che (, , True ) sia per abilitare il traspose ?

For I = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
‘ per “I” =1 a Cella(conta righe di colonna 1) dal basso a salire

If UCase(ShSt.Cells(I, 1)) = "X" Then
‘ trasforma in maiuscolo i riferimenti di foglio2, delle righe(I) di colonna 1 che contengono la X ,

cIcs = cIcs + 1
‘ qsto non mi è molto chiaro, penso sia un contatore che si incrementa di 1

.Range(.Cells(I, 2), .Cells(I, lastC)).Copy
‘ definisce il range tra cella I ( che contiene la X) di col.2 a cella (I) a ultima col. Di fo storico, in pratica la riga dati contrassegnata con la X

ShX.Range("A2").Offset(0, cIcs).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, , True
‘su foglio 2, a partire da A2, spostato di Clcs, incolla e trasponi
End If
Next I ‘ ripeti il ciclo per altro I contenete la (X)


Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 258
Iscritto il: 27/05/11 10:18

Re: Trasporre "dinamico"

Postdi Anthony47 » 27/01/19 00:47

Le tue interpretazioni sono essenzialmente giuste; aggiungo altri commenti nel codice pubblicato ieri sera:

Codice: Seleziona tutto
Dim I As Long, ShSt As Worksheet, ShX As Worksheet, lastC As Long, cIcs As Long
'
Set ShSt = Sheets("Storico")                              '<<< Il foglio coi dati da copiare
Set ShX = Sheets("Foglio2")                               '<<< Il foglio su cui copiare
'Individua ultima colonna usata su riga 1 = orari:
lastC = ShSt.Cells(1, Columns.Count).End(xlToLeft).Column
'Cancella su Foglio2 l'area contenente precedenti dati:
ShX.Range("A3").CurrentRegion.ClearContents         'AZZERA su Foglio2 l'area da A3 verso dx /il basso
With ShSt               'il With serve per semplificare le prossime istruzioni
    .Range(.Cells(1, "C"), .Cells(1, lastC)).Copy                 'Copia da Colonna C a Ultima
    ShX.Range("A3").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, , True     'Mette in verticale gli orari
    For I = 1 To .Cells(Rows.Count, 1).End(xlUp).Row         'Esamina col A da riga 1 alla "fine"
        If UCase(ShSt.Cells(I, 1)) = "X" Then                'si puo' usare sia x che X
            cIcs = cIcs + 1                                  'incrementa contatore delle "ics"
            .Range(.Cells(I, 2), .Cells(I, lastC)).Copy      'copia la riga dei Titolo da col B a Ultima...
            '... e incolla in verticale su Foglio2, usando cIcs per incrementare la colonna di destinaz
            ShX.Range("A2").Offset(0, cIcs).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone, , True
        End If
    Next I                                                   'prossima riga             
End With              ' "chiusura" del With
Application.CutCopyMode = False                              'cancella dati in clipboard


Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17656
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Trasporre "dinamico"

Postdi Gianca532011 » 27/01/19 10:03

Grazie, per il codice ma soprattutto per la spiegazione. Hai mai pensato di fare corsi di formazione in excel VBA ?
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 258
Iscritto il: 27/05/11 10:18

Re: Trasporre "dinamico"

Postdi Gianca532011 » 27/01/19 20:56

Altro problemino + una domanda .
la macro sotto dovrebbe colorare le celle differenti tra il foglio attuale e lo storico, ma si inceppa su lastC per mancanza "oggetto" errore 424. E non riesco a capire dove sta l'errore.
Codice: Seleziona tutto
Sub mColora()

    Dim sh1, sh2 As Worksheet
    Dim lRiga As Long
    Dim lastC, lastR As Long
   
    Dim S, cScs As Long
   
    Set sh = ThisWorkbook.Worksheets("Azioni_ITA")
    Set sh2 = ThisWorkbook.Worksheets("Storico")
         
    lastC = sh2.Cells(2, Colums.Count).End(xlToLeft).Column  ' trova ultima colonna dalla fine  verso sx del foglio "Storico"
    'lastR = sh2.Cells(2, Rows.Count).End(xlToUp).Row         ' trova ultima riga  a partire da 2 in  fo sh2
     
     With sh
           ' lRiga = sh.Cells(2, Rows.Count).End(xlToup).Row
           
            For S = 1 To .Cells(3, Rows.Count).End(xlToUp).Row  ' scansiona righe da 3 a ultima piena valida per entrambi i fogli
            If sh.Cells(S, 3).Value <> .sh2.Cells(S, lastC).Value Then ' se cella(s di colonna 3) è <> cella (s , Ultima colonna )di fo Storico
               
            .Range(.Cells(S, 3), .Cells(cScs, lastC)).Interior.Color = 3 ' rosso
           
            End If
            cScs = cScs + 1
        Next
               
    End With
        Set sh = Nothing
        Set sh2 = Nothing
End Sub


La domanda : da poco ho installato office 64 bit ed ho la netta impressione che qualche cosa sia cambiato , Mi sbaglio?
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 258
Iscritto il: 27/05/11 10:18

Re: Trasporre "dinamico"

Postdi Anthony47 » 27/01/19 23:04

Columns.Count

E stai attento che non esiste una costante di enumerazione xlToUp che vedo presente in un varie righe; cerca nell'help on line del vba la voce "xlDirection enumeration"
E, sempre qua e là, Cells(2, Rows.Count) e' concettualmente errato (guarda la sintassi di Cells, cempre nell'help on line del vba)

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17656
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Trasporre "dinamico"

Postdi Gianca532011 » 29/01/19 19:16

I "compiti " li ho fatti, non mi da' errore ma non fa neppure quanto dovrebbe :D :oops:
Codice: Seleziona tutto
Option Explicit
Sub mColora()

    Dim sh, sh2 As Worksheet
    Dim lRiga As Variant
    Dim lastC, lastR, riga, col As Long
     Dim myId As Double
    Dim S, sh2R As Long
   
    Set sh = ThisWorkbook.Worksheets("Azioni_ITA")
    Set sh2 = ThisWorkbook.Worksheets("Storico")
        sh.Unprotect
        sh2.Unprotect
   sh2R = 3
    lastC = sh2.Range("b3").End(xlToLeft).Columns  ' trova ultima colonna dalla fine  verso sx del foglio "Storico"
                       
           lRiga = sh.Range("c3").End(xlDown).Rows  ' riga finale in C a scendere
           If lRiga = "" Then
           MsgBox "Non ci sono dati"
           Exit Sub
           End If
           
            With sh
            riga = 3  'riga iniziale
            col = 3    ' colonna inizio
           
            For S = riga To lRiga
           
            myId = Cells(lRiga, 6).Value

            If myId <= 0 Then

                .Range(.Cells(lRiga, 6), .Cells(lRiga, 6)).Interior.ColorIndex = 46

            ElseIf myId >= 0 Then

                .Range(.Cells(lRiga, 6), .Cells(lRiga, 6)).Interior.ColorIndex = 6

            End If
              riga = riga + 1
           Next
                           
    End With
        Set sh = Nothing
        Set sh2 = Nothing
       
End Sub
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 258
Iscritto il: 27/05/11 10:18

Re: Trasporre "dinamico"

Postdi Gianca532011 » 29/01/19 21:19

Rettifico, questa funziona nel senso che evidenzia val. <> 0 ' li colora perfettamente , ha solo il problema che mi trascina il colore dell'ultima cella fino a 2200 ca ?
Option Explicit
Sub mColora()

Dim sh, sh2 As Worksheet
Dim lRiga As Variant
Dim lastC, lastR, riga, col As Long
Dim myId As Double
Dim S, sh2R As Long

Set sh = ThisWorkbook.Worksheets("Azioni_ITA")
Set sh2 = ThisWorkbook.Worksheets("Storico")
sh.Unprotect
sh2.Unprotect
sh2R = 3
lastC = sh2.Range("b3").End(xlToLeft).Columns ' trova ultima colonna dalla fine verso sx del foglio "Storico"
sh.Range("A43:zz2000").ClearContents
lRiga = sh.Cells(50, 3).End(xlUp).Rows ' riga finale in C a salire da 50
If lRiga = "" Then
MsgBox "Non ci sono dati"
Exit Sub
End If

With sh
riga = 3 'riga iniziale
col = 3 ' colonna inizio

For S = riga To lRiga

myId = Cells(riga, 6).Value

If myId <= 0 Then

.Range(.Cells(riga, 6), .Cells(riga, 6)).Interior.ColorIndex = 46

ElseIf myId >= 0 Then

.Range(.Cells(riga, 6), .Cells(riga, 6)).Interior.ColorIndex = 6

ElseIf Cells(43, 3).Value.Offset(1, 0) = "" Then
GoTo 10

End If
riga = riga + 1
Next
10
End With
Set sh = Nothing
Set sh2 = Nothing

End Sub


Lriga non funzia bene ?
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 258
Iscritto il: 27/05/11 10:18

Re: Trasporre "dinamico"

Postdi Anthony47 » 30/01/19 02:20

Purtroppo hai tradotto dall'italiano allo spagnolo senza usare il dizionario; bene la buona volonta', meno bene per la diligenza.

Non so quante istruzioni sono inventate; mi fermo su queste due:
Codice: Seleziona tutto
    lastC = sh2.Range("b3").End(xlToLeft).Columns  ' trova ultima colonna dalla fine  verso sx del foglio "Storico"
    lRiga = sh.Range("c3").End(xlDown).Rows  ' riga finale in C a scendere

L'help on line del vba per Range.Columns property mi dice:
-Returns a Range object that represents the columns in the specified range

Per Range.Rows analogamente:
-Returns a Range object that represents the rows in the specified range

Ovviamente avresti dovuto usare
Codice: Seleziona tutto
    lastC = sh2.Range("b3").End(xlToLeft).Column
    lRiga = sh.Range("c3").End(xlDown).Row 


Per continuare l'esercizio, guarda cosa dice (l'help on line del vba) a proposito di Range.Column e Range.Row

E se vuoi fare un bell'esercizio consulta e metti in pratica le istruzioni "Come debuggare una macro", fresche di pubblicazioni: viewtopic.php?f=26&t=103893&p=647677#p647677

Comincia con F8, poi procedi con qualche breakpoint nel codice, e usa la Finestra "Variabili locali" per visualizzare i tuoi dati.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17656
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Trasporre "dinamico"

Postdi Gianca532011 » 30/01/19 08:27

Ok, rifaccio i compiti.

Comunque, altre "squisitezze" et personalizzazioni a parte, ho risolto modificando cosi :

lRiga = sh.Range("B" & Rows.Count).End(xlUp).Row


intuizione di questa notte ore 3,30, mi sono perfino svegliato. :eeh:
Giancarlo
win 10 - Office 2016 Ita
Gianca532011
Utente Senior
 
Post: 258
Iscritto il: 27/05/11 10:18


Torna a Applicazioni Office Windows


Topic correlati a "Trasporre "dinamico"":


Chi c’è in linea

Visitano il forum: Nessuno e 57 ospiti

cron