Importa dati tra due date

[BG66]

Ciao a tutti.
Ultimo sforzo pre-ferragostano per gli uomini di buona volontà
Nel foglio "Elenco corsi" vorrei visualizzare tutti i corsi presenti in "Sheet" che soddisfino i requisiti temporali presenti in E6 ed E9.
Ho provato ad adattare lo script di Mario (vedi grassetto ) con scarsi risultati

Codice: Seleziona tutto

Sub SelezElenco()
Dim UP As String, RA As String, r As Long, uRG As Long, I As Long, [b]Data1 As Date, Data2 As Date[/b]
Dim Sh As Worksheet, sh1 As Worksheet
    Set Sh = Worksheets("Elenco Corsi")
    Set sh1 = Worksheets("Sheet")
    [b]Data1 = Sh.Range("E6")
    Data2 = Sh.Range("E9")[/b]
    UP = Cells(6, 3) 'assume C6
    'cerca in Sheet colonne varie
    uRG = sh1.Cells(Rows.Count, 1).End(xlUp).Row
    With Sh
        .Range("c12:f40").ClearContents
        r = 12
        For I = 2 To uRG
            If UP = sh1.Cells(I, 13) [b]And sh1.Cells("E6") >= Data1 And sh1.Cells("E9") <= Data2[/b] Then
                .Cells(r, 3) = sh1.Cells(I, 1) 'Tipo documento
                .Cells(r, 4) = sh1.Cells(I, 2) 'Descrizione tipo documento
                '.Cells(r, 5) = sh1.Cells(I, 6) 'data Inizio
                .Cells(r, 6) = sh1.Cells(I, 8) 'data Scadenza
                                                               
                r = r + 1
            End If
        Next I
    End With
   
    'Call OrdinaElenco
    Range("C6").Select
End Sub

In realtà avrei anche bisogno di "essere avvisato" se l'elenco superi le righe max presenti nel modulo (riga 40) con la richiesta di creare una seconda pagina ma per questo eventualmente creo un nuovo post!

https://www.dropbox.com/scl/fi/tfy15rkniedr0jkz2u3wy/DBoard-Corsi-VForum01.1.bis.xlsm?dl=0&rlkey=t39lsssri0axsx4laoauwk4ra
Grazie in anticipo
Gene

[Anthony47]

Anche tu pero' potevi metterci un po' di precisione nel descrivere il problema da risolvere, che ho interpretato a mia immaginazione in:
-vorrei avere l'elenco dei corsi che abbiano il periodo tra DATA INIZIO VALIDITÀ e DATA SCADENZA interamente compreso tra le date presenti in E6 ed F6 di "Elenco Corsi".

Ipotesi che ho tradotto in questo codice:

Codice: Seleziona tutto

Sub SelezElencoZZ()
Dim UP As String, RA As String, r As Long, uRG As Long, I As Long, Data1 As Date, Data2 As Date
Dim SH As Worksheet, EC As Worksheet
Set EC = Worksheets("Elenco Corsi")
Set SH = Worksheets("Sheet")
Data1 = EC.Range("E6")
Data2 = EC.Range("F6")
''??? UP = Cells(6, 3) 'assume C6
'cerca in Sheet colonne varie
uRG = SH.Cells(Rows.Count, 1).End(xlUp).Row
With EC
    .Range("c12:f40").ClearContents
    r = 12
    For I = 2 To uRG
        If SH.Cells(I, "F") <= Data1 And SH.Cells(I, "H") <= Data2 Then
            .Cells(r, 3) = SH.Cells(I, 1) 'Tipo documento
            .Cells(r, 4) = SH.Cells(I, 2) 'Descrizione tipo documento
            .Cells(r, 5) = SH.Cells(I, 6)  'data Inizio
            .Cells(r, 6) = SH.Cells(I, 8) 'data Scadenza
            r = r + 1
            If r > 40 Then
                Stop
            End If
        End If
    Next I
End With

'Call OrdinaElenco
Range("C6").Select
End Sub


Mi son permesso di chiamare SH il foglio Sheet e EC il foglio EstrattoConto (piuttosto che sh1 e sh rispettivamente)
Se nell'elenco dei risultati vuoi anche inserire il nominativo del DIPENDENTE ASSOCIATO aggiungerai una ulteriore riga prima di r=r+1
Per ora ho inserito uno Stop per fermarsi superata la riga 40; se spieghi che cosa vorresti fare oltre i 40 magari possiamo inserire qualcosa piu' furbo.
Se l'interpretazione che ho dato "non c'azzecca niente" allora evidentemente devi inserire un "supplemento di descrizione"...

[BG66]

Ciao Anthony,
scusami per la descrizione light

Se l'interpretazione che ho dato "non c'azzecca niente" allora evidentemente devi inserire un "supplemento di descrizione"...

In pratica vorrei riportare in "elenco corsi" solamente tutti i corsi che hanno la DATA INIZIO VALIDITA (colonna F del foglio Sheet) compresa nel range temporale definito da E6 ed F6.
Dato atteso:

In realtà l'elenco dovrebbe contenere solo il tipo documento che inizia con un numero. Quindi il vero risultato atteso dovrebbe essere:

ma se è una complicazione... và bene cosi!!

Per ora ho inserito uno Stop per fermarsi superata la riga 40; se spieghi che cosa vorresti fare oltre i 40 magari possiamo inserire qualcosa piu' furbo.

In pratica cosa posso fare per gestire la stampa o la visualizzazione dell'elenco se, in futuro, la "lista" dovesse superare la riga 40?

Grazie per l'aiuto
https://www.dropbox.com/scl/fi/b09opbuv5z19n923xjpt1/DBoard-Corsi-VForum02.0.bis.xlsm?dl=0&rlkey=36vl1x3y2rn7p4fixucmly3nn
Gene

[BG66]

Ciao Anthony,
il risultato "classico" l'ho ottenuto modificando la tua macro in questo punto:

Codice: Seleziona tutto

If SH.Cells(I, "F") >= Data1 And SH.Cells(I, "F") <= Data2 Then

Per le altre due implementazioni....attendo te.

PS Nell'immagine del dato atteso desiderato non avevo segnalato che presenta anche i doppioni dei documenti.
In breve il report ideale sarebbe cosi:


Buon Ferragosto
Gene

[Anthony47]

Bravo, hai fatto bene ad applicarti mentre noi eravamo impegnati nella classica scampagnata di ferragosto...
Se la data e' sempre inizio e fine dell'anno, allora si potrebbe anche semplificare in

Codice: Seleziona tutto

        If Year(SH.Cells(I, "F")) = .Cells(6, "C") Then

dimenticandosi di Data1 e Data2

Per gestire il vincolo dell'inizio numerico di TIPO DOCUMENTO si puo' aggiungere un If /Endif:

Codice: Seleziona tutto

        If Year(SH.Cells(I, "F")) = .Cells(6, "C") Then
            If IsNumeric(Left(SH.Cells(I, 1), 1)) Then
                .Cells(r, 3) = SH.Cells(I, 1) 'Tipo documento
                .Cells(r, 4) = SH.Cells(I, 2) 'Descrizione tipo documento
                .Cells(r, 5) = SH.Cells(I, 6)  'data Inizio
                .Cells(r, 6) = SH.Cells(I, 8) 'data Scadenza
                r = r + 1
                If r > 40 Then
                    Stop
                End If
            End If
        End If


Quanto al superamento dei 40, nell'ipotesi che puoi accettare un elenco lungo ma quello che non vorresti vedere e' una tabella senza formattazione, allora potremmo far finta di niente fino alla fine, salvo poi copiare la formattazione dalla prima riga a tutto l'elenco. Come fatto in questa penultima versione:

Codice: Seleziona tutto

Sub SelezElencoV1()
Dim UP As String, RA As String, r As Long, uRG As Long, I As Long, Data1 As Date, Data2 As Date
Dim SH As Worksheet, EC As Worksheet
Set EC = Worksheets("Elenco Corsi")
Set SH = Worksheets("Sheet")
Data1 = EC.Range("E6")
Data2 = EC.Range("F6")
''??? UP = Cells(6, 3) 'assume C6
'cerca in Sheet colonne varie
uRG = SH.Cells(Rows.Count, 1).End(xlUp).Row
With EC
    .Range("C12:f12").ClearContents
    .Range("C13:f1000").Clear
    r = 12
    For I = 2 To uRG
        If SH.Cells(I, "F") >= Data1 And SH.Cells(I, "F") <= Data2 Then
            If IsNumeric(Left(SH.Cells(I, 1), 1)) Then
                .Cells(r, 3) = SH.Cells(I, 1) 'Tipo documento
                .Cells(r, 4) = SH.Cells(I, 2) 'Descrizione tipo documento
                .Cells(r, 5) = SH.Cells(I, 6)  'data Inizio
                .Cells(r, 6) = SH.Cells(I, 8) 'data Scadenza
                r = r + 1
''                If r > 40 Then
''                    Stop
''                End If
            End If
        End If
    Next I
End With
EC.Range("C12:F12").Copy
EC.Range("C13").Resize(r - 12, 4).PasteSpecial xlPasteFormats
Application.CutCopyMode = False

'Call OrdinaElenco
Range("C6").Select
End Sub


Buon San Rocco...

[BG66]

Ciao Anthony,

Bravo, hai fatto bene ad applicarti mentre noi eravamo impegnati nella classica scampagnata di ferragosto...

Io sono solamente l'addetto alla brace... a cucinare ci pensano gli altri

Per la presenza della doppia indicazione riesci a fare qualcosa?

In pratica se il tipo documento e la data di inizio validità sono uguali basterebbe riportare l'informazione una sola volta....e questo dovrebbe aiutarmi a superare anche il limite delle righe massime

Grazie mille e buon San Rocco anche a te.

Gene

[Anthony47]

Avevo fatto bene a riservarmi la versione2...
Per evitare i doppioni inseriamo un ulteriore livello di IF /Endif e qualche altro aggiustamento di contorno:

Codice: Seleziona tutto

Sub SelezElencoV2()
Dim UP As String, RA As String, r As Long, uRG As Long, I As Long, Data1 As Date, Data2 As Date
Dim SH As Worksheet, EC As Worksheet
Dim ckArr()
'
Set EC = Worksheets("Elenco Corsi")
Set SH = Worksheets("Sheet")
Data1 = EC.Range("E6")
Data2 = EC.Range("F6")
''??? UP = Cells(6, 3) 'assume C6
'cerca in Sheet colonne varie
uRG = SH.Cells(Rows.Count, 1).End(xlUp).Row
ReDim ckArr(1 To uRG)
With EC
    .Range("C12:f12").ClearContents
    .Range("C13:f1000").Clear
    r = 12
    For I = 2 To uRG
        If SH.Cells(I, "F") >= Data1 And SH.Cells(I, "F") <= Data2 Then
''        If Year(SH.Cells(I, "F")) = .Cells(6, "C") Then
            If IsNumeric(Left(SH.Cells(I, 1), 1)) Then
                If IsError(Application.Match(SH.Cells(I, 1) & Format(SH.Cells(I, 6), "yyyy-mm-dd"), ckArr, False)) Then
                    .Cells(r, 3) = SH.Cells(I, 1) 'Tipo documento
                    .Cells(r, 4) = SH.Cells(I, 2) 'Descrizione tipo documento
                    .Cells(r, 5) = SH.Cells(I, 6)  'data Inizio
                    .Cells(r, 6) = SH.Cells(I, 8) 'data Scadenza
                    ckArr(r) = SH.Cells(I, 1) & Format(SH.Cells(I, 6), "yyyy-mm-dd")
                    r = r + 1
                End If
            End If
        End If
    Next I
End With
EC.Range("C12:F12").Copy
EC.Range("C13").Resize(r - 12, 4).PasteSpecial xlPasteFormats
Application.CutCopyMode = False

'Call OrdinaElenco
Range("C6").Select
End Sub


[BG66]

[RISOLTO]
Ciao Anthony,
grazie come al solito e alla prossima.
Gene