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

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [Συναρτήσεις] Ικανοποίηση συνθήκης βάσει ημερομηνίας (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/4963-ikanopoiisi-synthikis-basei-imerominias.html)

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

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

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

Ψάχνοντας βρήκα το παρακάτω, τροποποιώντας το στο κανονικό μου βιβλίο.
Όμως παρέλειψα κάτι σημαντικό, εάν έχω 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)))))))

Καλησπέρα

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

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

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

Κώδικας:

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

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

Παράθεση:

Compile error:
Constant expression required

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

Παράθεση:

startCel As String =

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

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

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

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

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

Κώδικας:

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 βάλε το φύλλο και το πρώτο κελί με τις ημερομηνίες.

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

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

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