trovare e scrivere date mancanti

[raimea]

ciao

tramite macro
vorrei scrive i giorni in cui non ho
avuto una partita.

analizzando le date in fgl 4_archivio
col F14:F
vorrei riportare i giorni " mancanti "
in fgl 5_tabelle da cella H66

x far capire ho scritto manualmente
le prime date mancanti

vi allego il file

https://www.dropbox.com/scl/fi/h8wczro1g9uty7g39zz9d/giorni-senza.xlsm?rlkey=i9z6a0cpntmsw103rfr266x1j&st=zwb4knrc&dl=0

ciao

[Anthony47]

Prova con questa:

Codice: Seleziona tutto

Sub MissingDays()
Dim wArr, oArr() As Long, I As Long, rDate As Range
'
Set rDate = Range(Sheets("4_archivio").Range("F14"), Sheets("4_archivio").Range("F14").End(xlDown))
ReDim oArr(Application.WorksheetFunction.Min(rDate) To Application.WorksheetFunction.Max(rDate), 1 To 1)
wArr = rDate.Value
For I = 1 To UBound(wArr)
    oArr((wArr(I, 1)), 1) = 1
Next I
For I = LBound(oArr) To UBound(oArr)
    If oArr(I, 1) = 0 Then
        Sheets("5_tabelle").Cells(Rows.Count, "H").End(xlUp).Offset(1, 0).Value = CDate(I)
    End If
Next I
End Sub

[raimea]

ciao

e' tutto ok

grazie

[raimea]

ciao
provo a chiedere se sarebbe possibile
una modifica/ aggiunta alla macro >> MissingDays

questa macro cerca date non scritte/trovate in fgl 4_archivio
e le riporta in fgl 5_tabelle riga H66

premesso che funziona correttamente.

se possibile,
attualmente le date
le scrive da riga H66 a seguire, ok

vorrei che venissero scritte fino max riga H116
e nel caso ci fossero altre date,
continuare a scriverle da K66

spero di essermi spiegato,

allego il file
https://www.dropbox.com/scl/fi/aqq6nc1x4m4wkpj6fp77r/Date-senza-schedine_2.xlsm?rlkey=gepgffhai9w357qf0t2trow7v&st=m96n7j9d&dl=0

ciao

[Anthony47]

Credo che questa versione faccia quanto richiesto, anche se limitatamente a due colonne di risultati (nel senso che se ci sono piu' di 102 giorni da riportare allora scriverà in colonna K oltre la riga 116; ma se questo non va bene allora si puo' rendere modulare utilizzando ulteriori colonne). Il codice:

Codice: Seleziona tutto

Sub MissingDays()
Dim wArr, oArr() As Long, I As Long, rDate As Range
'----------------------
' MARZO 2026 pc-facile
' serve a creare l elenco di giorni senza schedina
'  https://www.pc-facile.com/forum/viewtopic.php?f=26&t=113738
'
'-------------

Sheets("5_tabelle").Select
Set rDate = Range(Sheets("4_archivio").Range("F14"), Sheets("4_archivio").Range("F14").End(xlDown))
ReDim oArr(Application.WorksheetFunction.Min(rDate) To Application.WorksheetFunction.Max(rDate), 1 To 1)

Range("H66:L166").ClearContents

wArr = rDate.Value
For I = 1 To UBound(wArr)
    oArr((wArr(I, 1)), 1) = 1
Next I


'NEW:
Dim rNext As Long, kCol As Long, hMax As Long, kMax As Long, rAll As Range
Dim tDays As Long, mDays As Long, lMonth As Long

'Rimuovo tutti i bordi:
Range("H66:L166").Borders.LineStyle = xlNone
'Calcola giorni interessati:
tDays = Application.WorksheetFunction.Sum(oArr)
mDays = UBound(oArr) - LBound(oArr) - tDays + 1
'calcola le aree interessate
If mDays > 51 Then
    hMax = 51
    kMax = mDays - hMax
Else
    hMax = mDays
End If

'mette tutti i bordi
'Identifica l'area:
Set rAll = Range("H66").Resize(hMax, 2)
If kMax > 0 Then
    Set rAll = Application.Union(rAll, Range("K66").Resize(kMax, 2))
End If
'mette i bordi standard
With rAll
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlDash
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With

    With .Borders(xlInsideHorizontal)
        .LineStyle = xlDash
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
End With
'
'Mette le date mancanti e i separatori di mese
For I = LBound(oArr) To UBound(oArr)
    If oArr(I, 1) = 0 Then
        If rNext >= 116 And kCol = 0 Then
            kCol = 1
'            hMax = rNext
        End If
        rNext = Cells(Rows.Count, 8 + kCol * 3).End(xlUp).Row + 1
        Cells(rNext, 8 + kCol * 3).Value = CDate(I)
        If rNext > 66 Then
            'Mette eventuale separatore dei mesi:
            If Month(I) <> lMonth Then
                 With Cells(rNext - 1, 8 + kCol * 3).Resize(1, 2).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Color = 0          ' <<<  colore della riga
                    .TintAndShade = 0  ' colore riga
                    .Weight = xlThick  ' spessore riga
                End With
            End If
        End If
        lMonth = Month(I)
    End If
Next I
Range("D1").Select

End Sub

Noterai che il codice inserisce anche i bordi, integrando quindi il codice che avevi tu aggiunto al mio codice originale

[raimea]

cioa
tutto ok

perfetta

grazie

[Anthony47]

Ti avevo detto che la macro proposta nell’ultimo post limita a max 51 elementi la scrittura in colonna H, ma tutti gli altri (fossero anche 1000) sarebbero stati scritti in colonna K.
Questa versione e’ una evoluzione di quella macro, e limita a 51 il numero max di elementi scritti in ogni nuova colonna; ovviamente richiede che le colonne a destra della H siano libere da altri dati, altrimenti saranno sovrascritte senza preavviso.
Il codice:

Codice: Seleziona tutto

Sub MissingDays_V2()
Dim wArr, oArr() As Long, I As Long, rDate As Range
'----------------------
' MARZO 2026 pc-facile
' serve a creare l elenco di giorni senza schedina
'  https://www.pc-facile.com/forum/viewtopic.php?f=26&t=113738&sid=37dbfe35d06937272bb7ad6f90dc5fac
'
'-------------
'
Sheets("5_tabelle").Select
'
'Leggi dati:
Set rDate = Range(Sheets("4_archivio").Range("F14"), Sheets("4_archivio").Range("F14").End(xlDown))
ReDim oArr(Application.WorksheetFunction.Min(rDate) To Application.WorksheetFunction.Max(rDate), 1 To 1)
'
'marca le date presenti:
wArr = rDate.Value
For I = 1 To UBound(wArr)
    oArr((wArr(I, 1)), 1) = 1
Next I
'
'NEW:
Dim rNext As Long, kCol As Long, hMax As Long, kMax As Long, rAll As Range
Dim tDays As Long, mDays As Long, lMonth As Long
'
'Rimuovi vecchi dati, bordi e intestazioni:
Range("L65").Value = "."
Range(Range("H66"), Cells(65, Columns.Count).End(xlToLeft).Offset(51, 0)).Clear
Range(Range("H66"), Cells(65, Columns.Count).End(xlToLeft).Offset(51, 2)).Borders.LineStyle = xlNone
Range(Range("K65"), Cells(65, Columns.Count).End(xlToLeft)).Clear

'Calcola giorni interessati:
tDays = Application.WorksheetFunction.Sum(oArr)
mDays = UBound(oArr) - LBound(oArr) - tDays + 1
'calcola le aree interessate
If mDays < 52 Then
    Set rAll = Range("H66").Resize(hMax, 2)
Else
    Set rAll = Range("H66").Resize(51, 2)
    Do
        kCol = kCol + 1
        mDays = mDays - 51
        If mDays < 52 Then
            Set rAll = Application.Union(rAll, Range("H66").Offset(0, kCol * 3).Resize(mDays, 2))
            Exit Do
        Else
            Set rAll = Application.Union(rAll, Range("H66").Offset(0, kCol * 3).Resize(51, 2))
        End If
    Loop
End If
'
'mette formati e bordi standard
With rAll
    'Formato celle
    .NumberFormat = "ddd / dd-mmm 'yy"
    .HorizontalAlignment = xlHAlignCenterAcrossSelection
    'Cornice:
     .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium, Color:=0
    'Interlinea:
    With .Borders(xlInsideHorizontal)
        .LineStyle = xlDash
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
End With
'
'Mette le date mancanti e i separatori di mese
kCol = 0
For I = LBound(oArr) To UBound(oArr)
    If oArr(I, 1) = 0 Then
        If rNext >= 116 Then
            kCol = kCol + 1
            Range("H65:I65").Copy Cells(65, 8 + kCol * 3)
'            hMax = rNext
        End If
        rNext = Cells(Rows.Count, 8 + kCol * 3).End(xlUp).Row + 1
        Cells(rNext, 8 + kCol * 3).Value = CDate(I)
        Cells(rNext, 8 + kCol * 3).NumberFormat = "ddd / dd-mmm 'yy"
        Cells(rNext, 8 + kCol * 3 + 1).NumberFormat = "General"
       
        If rNext > 66 Then
            'Mette eventuale separatore dei mesi:
            If Month(I) <> lMonth Then
                 With Cells(rNext - 1, 8 + kCol * 3).Resize(1, 2).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Color = 0         ' colore della riga
                    .TintAndShade = 0
                    .Weight = xlThick  ' spessore riga
                End With
            End If
        End If
        lMonth = Month(I)
    End If
Next I
Range("D1").Select
End Sub


Prova, se ti interessa la prestazione

[raimea]

ciao
perfetta

non penso di arrivare a dover scrivere cosi tante date
da riempire piu colonne ma non si sa mai....

la tengo appuntando questa opzione

grazie mille