[Συναρτήσεις] Ικανοποίηση συνθήκης βάσει ημερομηνίας

[stam75]

Γεια σας!
Δεν ξέρω πόσο πιο συγκεκριμένα και με λίγα λόγια να περιγράψω το ζητούμενο στον τίτλο.
Στο βιβλίο έχω μια στήλη με ημερομηνίες.
Σε ένα κελί έχω αναπτυσσόμενη λίστα με επιλογές.
Αυτό που χρειάζομαι είναι το εξής.
Για την επιλογή Α, στις αναπτυσσόμενες λίστες, θέλω στην στήλη 1ο να εμφανίζονται οι διαθέσιμες ημερομηνίες που είναι καταχωρημένες στη στήλη B, από 1 έως και 15 Ιανουαρίου,
στην στήλη 2ο, από 16 έως και 31 Ιανουαρίου,
στην στήλη 3ο, από 1 έως και 15 Φεβρουαρίου,
στην στήλη 4ο, από 16 έως και 28 Φεβρουαρίου (ισχύει ότι θα προτιμηθεί να μην καταχωρηθεί η 29η στα δίσεκτα, εάν παίζει ρόλο).
Αντίστοιχα για Β Γ και Δ θα ισχύουν τα ίδια, απλά θα αλλάξω τις ημερομηνίες.
Έχω ένα παράδειγμα στο βιβλίο για το Α και το Β σε δύο ξεχωριστά φύλλα.

Εάν το κατανόησε κάποιος το ζητούμενο, γίνεται αυτό;
Ευχαριστώ πολύ

[stam75]

Ψάχνοντας βρήκα το παρακάτω, τροποποιώντας το στο κανονικό μου βιβλίο.
Όμως παρέλειψα κάτι σημαντικό, εάν έχω 2 φορές και περισσότερες την ίδια ημερομηνία θέλω να εμφανίζεται μόνο μια φορά στις στήλες.

Παρακάτω έχω χρωματίσει για να ξεχωρίσετε τα κομμάτια για τα Α Β Γ και Δ.
Και πάλι ευχαριστώ

IF($U$4="Α";INDEX('Φύλλο1'!$E$10:$E$2001;SMALL(IF('Φύλλο1'!$E$10:$E$2001>='Φύλλο2'!$N$1;IF('Φύλλο1'!$E$10:$E$2001<='Φύλλο2'!$O$1;ROW('Φύλλο1'!$E$10:$E$2001)-ROW('Φύλλο1'!$E$10)+1));ROWS('Φύλλο2'!$N$1:N1)));

IF($U$4="Β";INDEX('Φύλλο1'!$E$10:$E$2001;SMALL(IF('Φύλλο1'!$E$10:$E$2001>='Φύλλο2'!$N$4;IF('Φύλλο1'!$E$10:$E$2001<='Φύλλο2'!$O$4;ROW('Φύλλο1'!$E$10:$E$2001)-ROW('Φύλλο1'!$E$10)+1));ROWS('Φύλλο2'!$N$4:N4)));

IF($U$4="Γ";INDEX('Φύλλο1'!$E$10:$E$2001;SMALL(IF('Φύλλο1'!$E$10:$E$2001>='Φύλλο2'!$N$7;IF('Φύλλο1'!$E$10:$E$2001<='Φύλλο2'!$O$7;ROW('Φύλλο1'!$E$10:$E$2001)-ROW('Φύλλο1'!$E$10)+1));ROWS('Φύλλο2'!$N$7:N7)));

IF($U$4="Δ";INDEX('Φύλλο1'!$E$10:$E$2001;SMALL(IF('Φύλλο1'!$E$10:$E$2001>='Φύλλο2'!$N$10;IF('Φύλλο1'!$E$10:$E$2001<='Φύλλο2'!$O$10;ROW('Φύλλο1'!$E$10:$E$2001)-ROW('Φύλλο1'!$E$10)+1));ROWS('Φύλλο2'!$N$10:N10))))))) 

[kapetang]

Καλησπέρα

Σταμάτη, δες μια πρόταση στο συνημμένο.

Χρησιμοποιώ κώδικα.

[stam75]

Καλησπέρα Γιώργο, σε ευχαριστώ πολύ που απάντησες.
μετέφερα τον κώδικα στο βιβλίο μου, ενημέρωσα τις 3 περιοχές που έχεις βάλει στα Const
μόνο που δε ξέρω αν το έχω σωστό το παρακάτω γιατί είναι σε άλλο φύλλο

Const startCel As String = Φύλλο06.Range("E10")

Τώρα όταν επιλέγω από την αναπτυσσόμενη λίστα μετά από λίγο μου πετάει μήνυμα

Compile error:
Constant expression required

και μου μαρκάρει το

startCel As String =

[kapetang]

Σταμάτη το φύλλο, που έχει το Combo Box, στο οποίο θα γίνονται οι επιλογές είναι το ενεργό.

Δεν έχει σημασία το όνομά του.

Εκείνο που χρειάζεται είναι η προσθήκη του κώδικα και η αναγραφή, μέσα σε εισαγωγικά, των σωστών κελιών (χωρίς το όνομα φύλλου) στις εντολές Const.

[stam75]

Έχω μεταφέρει όλον τον κώδικα στο ενεργό φύλλο, στο βιβλίο μου.
Ήθελα να πω πως η λίστα με τις ημερομηνίες καταχωρούνται σε άλλο φύλλο. Όχι στο ενεργό, οπότε δεν πρέπει να γράψουμε το όνομα του φύλλου;
Επειδή είδα ότι στη συγκεκριμένη εντολή αναγράφεις το πρώτο κελί της λίστας με τις ημερομηνίες έβαλα το παραπάνω.

[kapetang]

Βάλε στο ενεργό φύλλο τον παρακάτω κώδικα:

Option Explicit
Const strSheet As String = "Φύλλο2"
Const startCel As String = "B4"     'αρχή των ημερομηνιών
Const startResult As String = "F3"  'αρχή αποτελεσμάτων
Const cboCel As String = "D2"       'κελί combobox


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngSource As Range, dct As Object, i As Long, key As Variant
    Dim D(1 To 6) As Long, M3 As Long, start3 As Date, end3 As Date
    Dim yr As Long, c As Range, d15 As Long, x() As Variant, sh As Worksheet
    
    On Error GoTo errHandler

    If Target.Count = 1 And Replace(Target.Address, "$", "") = cboCel Then
        Set sh = Worksheets(strSheet)
        Set rngSource = sh.Range(sh.Range(startCel), sh.Cells(Rows.Count, sh.Range(startCel).Column).End(xlUp))
        Set dct = CreateObject("Scripting.Dictionary")
        yr = Year(rngSource(1))
        M3 = Asc(Range(cboCel)) - 192
        start3 = DateSerial(yr, (M3 - 1) * 3 + 1, 1)
        end3 = DateSerial(yr, M3 * 3 + 1, 0)
        For Each c In rngSource
            If IsDate(c) Then
                If c >= start3 And c <= end3 Then
                    d15 = (Month(c) - M3 * 3 + 2) * 2 + IIf(Day(c) <= 15, 1, 2)
                    If Not dct.exists(c.Value) Then
                        dct(c.Value) = d15
                    End If
                End If
            End If
        Next
        Range(startResult).Resize(rngSource.Count, 6).ClearContents
        If dct.Count Then
            ReDim x(1 To dct.Count, 1 To 6) As Variant
            For Each key In dct.keys
                D(dct(key)) = D(dct(key)) + 1
                x(D(dct(key)), dct(key)) = key
            Next
            Range(startResult).Resize(dct.Count, 6).Value = x
        End If
    End If

    Exit Sub

errHandler:
    MsgBox Err.Description, vbCritical, "Error #" & Err.Number

End Sub

Στις 2 πρώτες Const βάλε το φύλλο και το πρώτο κελί με τις ημερομηνίες.

[stam75]

Όχι που δε θα το έβρισκες, είναι αυτό ακριβώς που ζητούσα! Γάτος είσαι Γιώργο, χίλια ευχαριστώ!

[kapetang]

Καλή συνέχεια Σταμάτη. Να είσαι καλά!

[stam75]

Άσχετο με το ζητούμενο, όταν πχ σε ένα βιβλίο έχεις 2000 σειρές σε μια στήλη όπου πρέπει να έρθει ένα αποτέλεσμα από ένα φύλλο, βάσει του αριθμού που έχει δίπλα του, στη διπλανή στήλη δηλαδή, τι είναι προτιμότερο; μια ίδια συνάρτηση στα 2000 κελιά της στήλης ή κωδικας;