Risultati da 1 a 19 di 19

Discussione: Macro per archiviare dati



  1. #1
    L'avatar di lizz1183
    Clicca e Apri
    Data Registrazione
    Jun 2016
    LocalitÓ
    Udine
    Messaggi
    23
    Versione Office
    Excel 2013
    Likes ricevuti
    0
    Likes dati
    0

    Macro per archiviare dati

    Buonasera a tutti!

    Vi chiedo aiuto per l'archiviazione automatica dei dati che trovate del Foglio1.

    Praticamente a me serve di poter inserire in dati nel Foglio1 e con una macro fare in modo che questi dati vengano memorizzati di volta in volta nel Foglio2, eseguendo le formule che ho giÓ inserito.
    Spero di essermi spiegata...

    Come posso fare?

    Grazie a tutti
    lizz1183
    File Allegati File Allegati

  2. #2

    L'avatar di alfrimpa
    Clicca e Apri
    Data Registrazione
    Dec 2015
    LocalitÓ
    Napoli
    EtÓ
    64
    Messaggi
    9786
    Versione Office
    2013
    Likes ricevuti
    1017
    Likes dati
    274

    Re: Macro per archiviare dati

    Ciao Lizz

    Giusto per capire in che direzione muovermi vorrei capire le modalitÓ di compilazione del foglio1

    Tu scrivi il nome del cliente in alto a sinistra (ora sono da cell e non posso aprire il file con Excel) e poi via via metti codici ed importti?

    Poi vorresti che sul foglio2 gli importi siano inseriti nelle rispettive colonne dei codici. ╚ corretto?

    Alfredo

  3. #3

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    LocalitÓ
    Como
    EtÓ
    54
    Messaggi
    10081
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2584
    Likes dati
    1554

    Re: Macro per archiviare dati

    Ciao a tutti,
    io ho capito cosý:

    Codice: 
    Sub inserisci()
    Dim wks1, wks2 As Worksheet
    Set wks1 = Worksheets("Foglio1")
    Set wks2 = Worksheets("Foglio2")
    wks2.Cells(2, 1) = wks1.Cells(1, 1)
    a = 2
        For y = 2 To 25
            For x = 2 To 38
                If wks1.Cells(y, 1) = wks2.Cells(1, x) Then
                    wks2.Cells(a, x).Offset(0, 1) = wks1.Cells(y, 2)
                End If
            Next
        a = a + 1
        Next
    Set wks1 = Nothing
    Set wks2 = Nothing
    End Sub
    Lizz fammi sapere.
    File Allegati File Allegati
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se pu˛ sembrare improbabile, non pu˛ che essere quella giusta!

  4. #4

    L'avatar di Rubik72
    Clicca e Apri
    Data Registrazione
    Dec 2015
    LocalitÓ
    Cosenza
    EtÓ
    46
    Messaggi
    3531
    Versione Office
    Excel 2013
    Likes ricevuti
    1228
    Likes dati
    1303

    Re: Macro per archiviare dati

    Prova con questa routine:
    Codice: 
    Sub Archivia()
    Dim uRiga As Long
    Dim i As Integer
    Dim x As Integer
    
    
    uRiga = Foglio2.Range("A" & Rows.Count).End(xlUp).Row + 1
    
    
    Foglio2.Cells(uRiga, 1) = Foglio1.Cells(1, 1)
    
    
    For i = 1 To 38
        For x = 2 To 29 Step 2
            If Foglio2.Cells(1, x) = Foglio1.Cells(i + 1, 1) Then
                Foglio2.Cells(uRiga, x) = Foglio2.Cells(uRiga, x) + 1
                Foglio2.Cells(uRiga, x + 1) = Foglio2.Cells(uRiga, x + 1) + Foglio1.Cells(i + 1, 2)
                Exit For
            End If
        Next
    Next
    
    
    End Sub
    EDIT: Ciao @Ges mi hai preceduto di poco

  5. I seguenti utenti hanno dato un "Like"


  6. #5
    L'avatar di lizz1183
    Clicca e Apri
    Data Registrazione
    Jun 2016
    LocalitÓ
    Udine
    Messaggi
    23
    Versione Office
    Excel 2013
    Likes ricevuti
    0
    Likes dati
    0

    Re: Macro per archiviare dati

    Rubik72 Ŕ proprio quello che cercavo!
    Grazie mille a tutti

  7. #6
    L'avatar di Gerardo ZuccalÓ
    Clicca e Apri
    Data Registrazione
    May 2015
    LocalitÓ
    Milano, Italy
    EtÓ
    50
    Messaggi
    5388
    Versione Office
    office 365/2016
    Likes ricevuti
    1274
    Likes dati
    1342

    Re: Macro per archiviare dati

    @rubick questa routine Ŕ uno spettacolo
    sarebbe bello capirla, se hai tempo e voglia potresti spiegarla, perchŔ Ŕ veramente spaziale e poi sto un po imparando

    Un saluto
    Se non lo sai spiegare in modo semplice, non l'hai capito abbastanza bene Cit. Einstein

  8. #7
    L'avatar di Cuc¨^_^
    Clicca e Apri
    Data Registrazione
    Jun 2016
    LocalitÓ
    TrentoGallipoliTaranto
    EtÓ
    46
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    68
    Likes dati
    34

    Re: Macro per archiviare dati

    Qualora i codici da controllare fossero molti e volendo ottimizzare i tempi eliminando cicli inutili io proporrei:
    Codice: 
    Option Explicit
    
    Sub Cucu()
    Dim ur As Long, ur2 As Long, i As Long
    Dim cod() As Variant
    Dim Rng As Range, Xc As Range
    
    
    Application.ScreenUpdating = False
    Foglio2.Range("A65536").End(xlUp).Offset(1, 0) = Foglio1.Cells(1, 1)
    ur = Foglio1.Range("A" & Rows.Count).End(xlUp).Row
    ur2 = Foglio2.Range("A" & Rows.Count).End(xlUp).Row
    Set Rng = Foglio2.Cells(1, 1).EntireRow
    cod() = Foglio1.Range("A2:B" & ur)
    
    
    For i = 1 To UBound(cod)
        Set Xc = Rng.Find(cod(i, 1), LookIn:=xlValues, lookat:=xlWhole)
            If Not Xc Is Nothing Then
                Foglio2.Cells(ur2, Xc.Column).Value = Foglio2.Cells(ur2, Xc.Column).Value + 1
                Foglio2.Cells(ur2, Xc.Column + 1).Value = Foglio2.Cells(ur2, Xc.Column + 1).Value + cod(i, 2)
            End If
    Next i
    Application.ScreenUpdating = True
    
    
    End Sub
    Cuc¨

  9. #8
    L'avatar di Raffaele_53
    Clicca e Apri
    Data Registrazione
    Dec 2015
    LocalitÓ
    Binasco
    EtÓ
    64
    Messaggi
    506
    Versione Office
    2007
    Likes ricevuti
    85
    Likes dati
    7

    Re: Macro per archiviare dati

    Scusami Cuc¨^_^
    >>>Foglio2.Range("A65536")........
    Non mi sembra giusto?

  10. #9
    L'avatar di Cuc¨^_^
    Clicca e Apri
    Data Registrazione
    Jun 2016
    LocalitÓ
    TrentoGallipoliTaranto
    EtÓ
    46
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    68
    Likes dati
    34

    Re: Macro per archiviare dati

    Bhe... se Foglio2.Range("A65536") non ti sembra giusto (ma lo Ŕ) cosa ne pensi di
    Codice: 
    For i = 1 To 38
        For x = 2 To 29 Step 2



  11. #10
    L'avatar di Raffaele_53
    Clicca e Apri
    Data Registrazione
    Dec 2015
    LocalitÓ
    Binasco
    EtÓ
    64
    Messaggi
    506
    Versione Office
    2007
    Likes ricevuti
    85
    Likes dati
    7

    Re: Macro per archiviare dati

    Penso solo che excel2013 non siano sufficenti 65536 righe

  12. #11
    L'avatar di Cuc¨^_^
    Clicca e Apri
    Data Registrazione
    Jun 2016
    LocalitÓ
    TrentoGallipoliTaranto
    EtÓ
    46
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    68
    Likes dati
    34

    Re: Macro per archiviare dati

    Ripeto se 65000 righe non sono sufficienti, come valuti il ciclo
    Codice: 
    For i = 1 To 38
    
    ?

  13. #12
    L'avatar di Raffaele_53
    Clicca e Apri
    Data Registrazione
    Dec 2015
    LocalitÓ
    Binasco
    EtÓ
    64
    Messaggi
    506
    Versione Office
    2007
    Likes ricevuti
    85
    Likes dati
    7

    Re: Macro per archiviare dati

    SarÓ come dici, per˛ da excel2007 uso Range("A" & Rows.Count).End(xlUp).Row
    Non mi interessa che siano solo 29 righe
    Fossero 100.000 deve funzionare sempre

  14. #13
    L'avatar di Cuc¨^_^
    Clicca e Apri
    Data Registrazione
    Jun 2016
    LocalitÓ
    TrentoGallipoliTaranto
    EtÓ
    46
    Messaggi
    419
    Versione Office
    2010
    Likes ricevuti
    68
    Likes dati
    34

    Re: Macro per archiviare dati

    Bhe allora...
    Codice: 
    Option Explicit
    
    Sub Cucu()
    Dim ur As Long, ur2 As Long, i As Long
    Dim cod() As Variant
    Dim Rng As Range, Xc As Range
    
    
    Application.ScreenUpdating = False
    ur = Foglio1.Range("A" & Rows.Count).End(xlUp).Row
    ur2 = Foglio2.Range("A" & Rows.Count).End(xlUp).Row + 1
    Foglio2.Range("A" & ur2) = Foglio1.Cells(1, 1)
    Set Rng = Foglio2.Cells(1, 1).EntireRow
    cod() = Foglio1.Range("A2:B" & ur)
    For i = 1 To UBound(cod)
        Set Xc = Rng.Find(cod(i, 1), LookIn:=xlValues, lookat:=xlWhole)
            If Not Xc Is Nothing Then
                Foglio2.Cells(ur2, Xc.Column).Value = Foglio2.Cells(ur2, Xc.Column).Value + 1
                Foglio2.Cells(ur2, Xc.Column + 1).Value = Foglio2.Cells(ur2, Xc.Column + 1).Value + cod(i, 2)
            End If
    Next i
    Application.ScreenUpdating = True
    
    
    End Sub

  15. I seguenti 2 utenti hanno dato un "Like" a Cuc¨^_^ per questo post:


  16. #14

    L'avatar di Rubik72
    Clicca e Apri
    Data Registrazione
    Dec 2015
    LocalitÓ
    Cosenza
    EtÓ
    46
    Messaggi
    3531
    Versione Office
    Excel 2013
    Likes ricevuti
    1228
    Likes dati
    1303

    Re: Macro per archiviare dati

    Citazione Originariamente Scritto da Gerardo ZuccalÓ Visualizza Messaggio
    @rubick questa routine Ŕ uno spettacolo
    sarebbe bello capirla, se hai tempo e voglia potresti spiegarla, perchŔ Ŕ veramente spaziale e poi sto un po imparando

    Un saluto
    Ciao @Gerardo ZuccalÓ, la routine Ŕ abbastanza semplice.
    Ci sono due dicli, uno che controlla le righe del Foglio1 (i), l'altro le colonne del Foglio2 (x).
    Quando viene trovato il "codice" lo scive nella prima riga vuota del Foglio2.

    Codice: 
    Sub Archivia()
    Dim uRiga As Long
    Dim i As Integer
    Dim x As Integer
    
    
    uRiga = Foglio2.Range("A" & Rows.Count).End(xlUp).Row + 1 'ricerca prima riga vuota (ultima riga+1) del foglio2
    
    
    Foglio2.Cells(uRiga, 1) = Foglio1.Cells(1, 1) 'scrittura Cliente
    
    
    For i = 2 To 25 'primo ciclo che controlla le righe da 2 a 25 del Foglio1
        For x = 2 To 38 Step 2 'secondo ciclo che controlla le colonne alterne del Foglio2 da 2 a 38
            If Foglio2.Cells(1, x) = Foglio1.Cells(i + 1, 1) Then 'se trova il codice del Foglio1 nell'intestazione del Foglio2...
                Foglio2.Cells(uRiga, x) = Foglio2.Cells(uRiga, x) + 1 'scivi il conteggio (numero precedente +1)
                Foglio2.Cells(uRiga, x + 1) = Foglio2.Cells(uRiga, x + 1) + Foglio1.Cells(i + 1, 2) 'somma al valore precedente il valore trovato
                Exit For
            End If
        Next
    Next
    
    
    End Sub
    P.S. Ho modificato il valore delle variabili che non era completo.

  17. I seguenti 2 utenti hanno dato un "Like" a Rubik72 per questo post:


  18. #15
    L'avatar di Gerardo ZuccalÓ
    Clicca e Apri
    Data Registrazione
    May 2015
    LocalitÓ
    Milano, Italy
    EtÓ
    50
    Messaggi
    5388
    Versione Office
    office 365/2016
    Likes ricevuti
    1274
    Likes dati
    1342

    Re: Macro per archiviare dati

    Grazie a tutti
    @Rubik, adesso me la studio un pochettino con il tasto F8 e la finestra immediata CTRL+G
    Grazie
    ciao
    Se non lo sai spiegare in modo semplice, non l'hai capito abbastanza bene Cit. Einstein

  19. #16

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    LocalitÓ
    Como
    EtÓ
    54
    Messaggi
    10081
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2584
    Likes dati
    1554

    Re: Macro per archiviare dati

    Ciao a tutti,
    complimenti alle ottime soluzioni proposte, ma voglio ancora tornare alla funzionale e ottima routine di Roubik e dico .... abbiamo fatto 30 facciamo 31

    .... voglio eliminare tutte le formule del foglio 2 e far fare i calcoli al vba.

    Integro la routine di Rubik con la seguente:

    Codice: 
    Sub Archivia()
        Dim uRiga As Long, i, x, y, z As Integer
        Application.ScreenUpdating = False
        Foglio2.Range("B28:AP28") = ""
        uRiga = Foglio2.Range("A" & Rows.Count).End(xlUp).Row + 1
        Foglio2.Cells(uRiga, 1) = Foglio1.Cells(1, 1)
        For i = 1 To 38
            For x = 2 To 29 Step 2
                With Foglio2
                    If .Cells(1, x) = Foglio1.Cells(i + 1, 1) Then
                        .Cells(uRiga, x) = .Cells(uRiga, x) + 1
                        .Cells(uRiga, x + 1) = .Cells(uRiga, x + 1) + Foglio1.Cells(i + 1, 2)
                        .Cells(uRiga, 41) = .Cells(uRiga, 41) + 1
                        .Cells(uRiga, 42) = .Cells(uRiga, 42) + Foglio1.Cells(i + 1, 2)
                        Exit For
                    End If
                End With
            Next
        Next
            For z = 2 To 27
            For y = 2 To 42
                Foglio2.Cells(28, y) = Foglio2.Cells(28, y) + Foglio2.Cells(z, y)
            Next
        Next
        Application.ScreenUpdating = True
    End Sub
    File Allegati File Allegati
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se pu˛ sembrare improbabile, non pu˛ che essere quella giusta!

  20. #17
    L'avatar di bopo57
    Clicca e Apri
    Data Registrazione
    Aug 2016
    LocalitÓ
    Milano
    EtÓ
    60
    Messaggi
    193
    Versione Office
    2007
    Likes ricevuti
    7
    Likes dati
    19

    Re: Macro per archiviare dati

    Buonasera,
    Ho preso 2 pc, in uno ho messo il video di Gerardo sull'archiviazione dati e nell'altro avevo il foglio excel aperto.
    Ad ogni passaggio, bloccavo il video e lo ripetevo su excel.
    Niente da fare!!! Mi prende solamente la prima riga, mentre la seconda...........nisba!!!
    Altra cosa, nel foglio ARCHIVIO, ho implementato (sempre da video by Gerardo) somma.pi¨.se, che funziona regolarmente se immetto i dati a mano, ma non funziona se archivio con la macro.
    Potete aiutarmi?
    Grazie
    File Allegati File Allegati

  21. #18

    L'avatar di Rubik72
    Clicca e Apri
    Data Registrazione
    Dec 2015
    LocalitÓ
    Cosenza
    EtÓ
    46
    Messaggi
    3531
    Versione Office
    Excel 2013
    Likes ricevuti
    1228
    Likes dati
    1303

    Re: Macro per archiviare dati

    Citazione Originariamente Scritto da bopo57 Visualizza Messaggio
    Buonasera,
    Ho preso 2 pc, in uno ho messo il video di Gerardo sull'archiviazione dati e nell'altro avevo il foglio excel aperto.
    Ad ogni passaggio, bloccavo il video e lo ripetevo su excel.
    Niente da fare!!! Mi prende solamente la prima riga, mentre la seconda...........nisba!!!
    Altra cosa, nel foglio ARCHIVIO, ho implementato (sempre da video by Gerardo) somma.pi¨.se, che funziona regolarmente se immetto i dati a mano, ma non funziona se archivio con la macro.
    Potete aiutarmi?
    Grazie
    ciao @bopo57, per chiedere aiuto Ŕ meglio iniziare una nuova discussione che accodarsi ad una esistente

  22. #19
    L'avatar di bopo57
    Clicca e Apri
    Data Registrazione
    Aug 2016
    LocalitÓ
    Milano
    EtÓ
    60
    Messaggi
    193
    Versione Office
    2007
    Likes ricevuti
    7
    Likes dati
    19

    Re: Macro per archiviare dati

    Hai ragione e chiedo scusa, ma Ŕ il primo forum al quale mi sono iscritto e non sono molto pratico.
    Rimedio subito!!!

Discussioni Simili

  1. Risposte: 23
    Ultimo Messaggio: 23/02/16, 11:16
  2. macro per ARCHIVIARE DATI
    Di rosarioleotta nel forum Domande su Excel in generale
    Risposte: 5
    Ultimo Messaggio: 19/02/16, 19:16
  3. macro per ARCHIVIARE DATI
    Di rosarioleotta nel forum Domande su Excel VBA e MACRO
    Risposte: 5
    Ultimo Messaggio: 19/02/16, 19:16
  4. EP56 le MACRO di excel per ARCHIVIARE dati ( Macro assolutI e relativI)
    Di giackko86 nel forum Domande su Excel VBA e MACRO
    Risposte: 4
    Ultimo Messaggio: 10/09/15, 21:59
  5. 56 le MACRO di excel per ARCHIVIARE dati ( Macro assolutI e relativI)
    Di giackko86 nel forum Domande su Excel in generale
    Risposte: 1
    Ultimo Messaggio: 10/09/15, 19:41

Permessi di Scrittura

  • Tu non puoi inviare nuove discussioni
  • Tu non puoi inviare risposte
  • Tu non puoi inviare allegati
  • Tu non puoi modificare i tuoi messaggi
  •