IALweb Homepage
Forum Home Forum Home > MS Office > Microsoft Office > Microsoft Excel
  New Posts New Posts RSS Feed - Copia celle contiene data della settimana
  FAQ FAQ  Forum Search   Events   Register Register  Login Login


REGISTRATEVI su IALWeb forum!

Copia celle contiene data della settimana

 Post Reply Post Reply Page  <12
Author
Message
dodo47 View Drop Down
Moderatore
Moderatore
Avatar

Joined: 29/Dic/2008
Location: Italy
Status: Offline
Points: 11938
Post Options Post Options   Thanks (0) Thanks(0)   Quote dodo47 Quote  Post ReplyReply Direct Link To This Post Posted: 11/Gen/2019 at 10:11
mi era sfuggito......alla settimana precedente a quale??

fai un esempio


Edited by dodo47 - 11/Gen/2019 at 11:13
domenico
win 10- office 2016
Back to Top
Sponsored Links


Back to Top
chiarava79 View Drop Down
Utente Senior
Utente Senior
Avatar

Joined: 29/Dic/2017
Status: Offline
Points: 225
Post Options Post Options   Thanks (0) Thanks(0)   Quote chiarava79 Quote  Post ReplyReply Direct Link To This Post 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
Back to Top
dodo47 View Drop Down
Moderatore
Moderatore
Avatar

Joined: 29/Dic/2008
Location: Italy
Status: Offline
Points: 11938
Post Options Post Options   Thanks (0) Thanks(0)   Quote dodo47 Quote  Post ReplyReply Direct Link To This Post 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
Back to Top
 Post Reply Post Reply Page  <12
  Share Topic   

Forum Jump Forum Permissions View Drop Down

Forum Software by Web Wiz Forums® version 10.17
Copyright ©2001-2013 Web Wiz Ltd.

This page was generated in 0,049 seconds.