Print Page | Close Window

Copia celle contiene data della settimana

Printed From: IALweb
Category: MS Office
Forum Name: Microsoft Excel
Forum Discription: Tutto sui fogli di calcolo e l'automazione d'ufficio
URL: https://forum.ialweb.it/forum_posts.asp?TID=16467531
Printed Date: 25/Mag/2019 at 17:46
Software Version: Web Wiz Forums 10.17 - http://www.webwizforums.com


Topic: Copia celle contiene data della settimana
Posted By: chiarava79
Subject: Copia celle contiene data della settimana
Date Posted: 08/Gen/2019 at 10:31
Ciao a tutti ed innanzitutto Buon anno anche se in ritardo.......

Vorrei chiedervi un aiuto: 

ho un database contenente numerose colonne che si ripetono, nel senso che la colonna C e la colonna E contengono dei dati e la colonna D una data nel formato "dd/mm/yyyy" La colonna F e la colonna H nuovamente dei dati sempre in formato Testo e la colonna G una data in formato "dd/mm/yyyy" e così via.....

Io avrei la necessità che  venissero copiate in un altro foglio e incolonnati i dati contenuti nelle righe delle colonne A /  B e quelli delle altre colonne in copia ( ad es. C / E oppure F / H ) se la data è riferita alla settimana precedente 

Vi allego un esempio

uploads/21403/Copia_dati.zip" rel="nofollow - uploads/21403/Copia_dati.zip

Come vedete, sono stati riportati i dati eccetto quello inserito in data 23/12/2018

Ad ogni riga aggiunta mi servirebbe che venisse riportata l'intestazione
Grazie!!!




Replies:
Posted By: dodo47
Date Posted: 09/Gen/2019 at 09:37
Ciao
(lavoro strano)

comunque: i dati al massimo finiscono in col. H o possono proseguire??

saluti


-------------
domenico
win 10- office 2016


Posted By: chiarava79
Date Posted: 09/Gen/2019 at 11:26
No possono proseguire..... anzi, a dire il vero proseguono fino a FO   CryCry


Posted By: dodo47
Date Posted: 09/Gen/2019 at 12:33
Ciao
è un po' raffazzonato, ma....

saluti

uploads/17743/Copia_dati_2.zip" rel="nofollow - uploads/17743/Copia_dati_2.zip


-------------
domenico
win 10- office 2016


Posted By: chiarava79
Date Posted: 09/Gen/2019 at 13:04
Ti ringrazio moltissimo....

e' proprio quel che volevo...!!!!

Ultima cosa se posso "abusare" della tua disponibilità

Sarebbe possibile ottenere che venga copiata/incollata il testo contenuto nella cella della riga d'intestazione della colonna corretta?

Ti faccio un esempio

Se la cella D1 contiene il testo "Data inserimento dato" mentre la G1 "data inserimento dato 2" , mi servirebbe che venisse riportato nella cella D3 e D9 del foglio2 "data inserimento dato 2"

Grazie!!!Big smileBig smileBig smileBig smile




Posted By: dodo47
Date Posted: 09/Gen/2019 at 16:36
prova:
Sub copia()
Dim mFr As Worksheet, mTo As Worksheet, intestazione As Range, ur As Long
Set mFr = Worksheets("Foglio1")
Set mTo = Worksheets("Foglio2")
ur = mFr.Range("A" & Rows.Count).End(xlUp).Row
rt = 1
rf = 2
Worksheets("Foglio2").Select
Cells.ClearContents
For j = 2 To ur
    Set intestazione = mFr.Range("A1:E1")
    mTo.Range(Cells(rt, 1), Cells(rt, 5)) = intestazione.Value
    rt = rt + 1
    For i = 1 To 5
        mTo.Cells(rt, i) = mFr.Cells(j, i)
    Next i
    k = i
    Do Until mFr.Cells(j, k) = ""
        rt = rt + 1
        With mFr
            Set intestazione = Range(.Cells(1, k), .Cells(1, k + 2))
        End With
        mTo.Cells(rt, 1) = mFr.Cells(1, 1)
        mTo.Cells(rt, 2) = mFr.Cells(1, 2)
        mTo.Range(Cells(rt, 3), Cells(rt, 5)) = intestazione.Value
        rt = rt + 1
        mTo.Cells(rt, 1) = mFr.Cells(j, 1)
        mTo.Cells(rt, 2) = mFr.Cells(j, 2)
        mTo.Cells(rt, 3) = mFr.Cells(j, k)
        k = k + 1
        mTo.Cells(rt, 4) = mFr.Cells(j, k)
        k = k + 1
        mTo.Cells(rt, 5) = mFr.Cells(j, k)
        k = k + 1
    Loop
    rt = rt + 1
Next j
End Sub

Saluti


-------------
domenico
win 10- office 2016


Posted By: chiarava79
Date Posted: 09/Gen/2019 at 17:17
FUNZIONAAAAAAAAAAAAAAAAAAAAA!!!!!!!!!!!!!!!!!!!!!!!!   LOLSmile

Quando hai tempo mi potresti inserire le spiegazioni nella macro? Non spero di riuscirci, ma almeno vorrei tentare di capire qualcosa dei comandi Approve


Posted By: dodo47
Date Posted: 10/Gen/2019 at 09:44
Ciao
premetto che quel codice sarebbe completamente da rifare.
Comunque questi sono i commenti
Saluti

Sub copia()
Dim mFr As Worksheet, mTo As Worksheet, intestazione As Range, ur As Long
'assegna a variabili i fogli
Set mFr = Worksheets("Foglio1")
Set mTo = Worksheets("Foglio2")
'calcola ultima riga foglio1
ur = mFr.Range("A" & Rows.Count).End(xlUp).Row
rt = 1 ' riga inizio scrittura su foglio2
rf = 2 'NON UTILIZZATA puoi cancellare
Worksheets("Foglio2").Select 'seleziona il foglio2
Cells.ClearContents 'pulisce i risultati precedenti

'apre un ciclo per analizzare tutte le righe del foglio1
For j = 2 To ur
    
    'prima intestazione del foglio1
    Set intestazione = mFr.Range("A1:E1")
    mTo.Range(Cells(rt, 1), Cells(rt, 5)) = intestazione.Value
    
    rt = rt + 1
    'copia il primo blocco di dati sul foglio2
    For i = 1 To 5
        mTo.Cells(rt, i) = mFr.Cells(j, i)
    Next i
    k = i
    
    'cerca se ci sono successivi blocchi dati da riportare per lo stesso nominativo
    Do Until mFr.Cells(j, k) = ""
        rt = rt + 1
        'valorizza successiva intestazione
        With mFr
            Set intestazione = Range(.Cells(1, k), .Cells(1, k + 2))
        End With
        'riporta nome bambino e fratello
        mTo.Cells(rt, 1) = mFr.Cells(1, 1)
        mTo.Cells(rt, 2) = mFr.Cells(1, 2)
        ' scrive intestazione successiva
        mTo.Range(Cells(rt, 3), Cells(rt, 5)) = intestazione.Value
        rt = rt + 1
        
        'riporta nome bambino e fratello su riga seguente
        mTo.Cells(rt, 1) = mFr.Cells(j, 1)
        mTo.Cells(rt, 2) = mFr.Cells(j, 2)
        
        ' riporta successivi dati: scuola-data ins-città
        mTo.Cells(rt, 3) = mFr.Cells(j, k)
        k = k + 1
        mTo.Cells(rt, 4) = mFr.Cells(j, k)
        k = k + 1
        mTo.Cells(rt, 5) = mFr.Cells(j, k)
        k = k + 1
    Loop
    rt = rt + 1
Next j
End Sub



-------------
domenico
win 10- office 2016


Posted By: chiarava79
Date Posted: 10/Gen/2019 at 16:20
Da rifare....'!?!?! Ma è perfetto......

GRAZIEEEEE


Posted By: chiarava79
Date Posted: 11/Gen/2019 at 09:50
.... perdonami..... 

Mi sono accorta di una cosa... la macro riporta nel foglio 2 tutti i dati anche quelli la cui data non riguarda la settimana precedente. 

Io avrei la necessità che  venissero copiate in un altro foglio e incolonnati i dati contenuti nelle righe delle colonne A /  B e quelli delle altre colonne in copia ( ad es. C / E oppure F / H ) se la data è riferita alla settimana precedente 


Posted By: dodo47
Date Posted: 11/Gen/2019 at 10:11
mi era sfuggito......alla settimana precedente a quale??

fai un esempio


-------------
domenico
win 10- office 2016


Posted By: chiarava79
Date Posted: 11/Gen/2019 at 12:09
La settimana precedente a quella attuale.... per settimana attuale intendo quella in cui esegui la macro

Ad es. se la eseguo in data 11/01/2019 dovrebbe copiare le righe contenenti le date della settimana che va dal  
31/12/2018 al 06/01/2019 compresi

Se invece la eseguirò in data 17/01/2019 allora l'intervallo sarà 07/01/2019 - 13/01/2019

Non so se è fattibile una cosa del genere...... Ermm
GRAZIE


Posted By: dodo47
Date Posted: 11/Gen/2019 at 18:23
Ciao
ho rivisto tutta la macro, fai le tue prove...
saluti

Sub copia()
Dim mFr As Worksheet, mTo As Worksheet, intestazione As Range, ur As Long
Dim LastMonday As Date, mData As Date, Lun As Date, Dom As Date

'assegna a variabili i fogli
Set mFr = Worksheets("Foglio1")
Set mTo = Worksheets("Foglio2")
'calcola ultima riga foglio1
ur = mFr.Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Foglio2").Select 'seleziona il foglio2
Cells.ClearContents 'pulisce i risultati precedenti
'calcolo settimana precedente
Lun = DateAdd("ww", -1, Date - (Weekday(Date, vbUseSystemDayOfWeek)) + 1)
Dom = DateAdd("ww", -1, Date - (Weekday(Date, vbUseSystemDayOfWeek)) + 7)

'apre un ciclo per analizzare tutte le righe del foglio1
For j = 2 To ur
    uc = mFr.Cells(1, mFr.Columns.Count).End(xlToLeft).Column 'ultima colonna riga
    mData = mFr.Cells(j, 4) ' data in elaborazione
    If mData >= Lun And mData <= Dom Then ' controllo se data entra nei parametri
        rt = rt + 1 ' incremento riga
        Set intestazione = mFr.Range("A1:E1") ' stampa prima intestazione
        mTo.Range(Cells(rt, 1), Cells(rt, 5)) = intestazione.Value
        rt = rt + 1
        'stampa dati prime colonne
        For i = 1 To 5
            mTo.Cells(rt, i) = mFr.Cells(j, i)
        Next i
    End If
    ' ciclo per successive colonne
    For i = 6 To uc Step 3
        mData = mFr.Cells(j, i + 1)
        If mData >= Lun And mData <= Dom Then
        rt = rt + 1
        mTo.Range("A" & rt) = mFr.Cells(1, 1)
        mTo.Range("B" & rt) = mFr.Cells(1, 2)
        mTo.Range("C" & rt) = mFr.Cells(1, i)
        mTo.Range("D" & rt) = mFr.Cells(1, i + 1)
        mTo.Range("E" & rt) = mFr.Cells(1, i + 2)
        rt = rt + 1
        mTo.Range("A" & rt) = mFr.Cells(j, 1)
        mTo.Range("B" & rt) = mFr.Cells(j, 2)
        mTo.Range("C" & rt) = mFr.Cells(j, i)
        mTo.Range("D" & rt) = mFr.Cells(j, i + 1)
        mTo.Range("E" & rt) = mFr.Cells(j, i + 2)
        End If
    Next i
Next j


-------------
domenico
win 10- office 2016



Print Page | Close Window

Forum Software by Web Wiz Forums® version 10.17 - http://www.webwizforums.com
Copyright ©2001-2013 Web Wiz Ltd. - http://www.webwiz.co.uk