Forum - VBA Αναζήτηση δεδομένων ανάμεσα σε δύο ημερομηνίες

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

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

- - [VBA] Αναζήτηση δεδομένων ανάμεσα σε δύο ημερομηνίες (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/4714-anazitisi-dedomenon-anamesa-se-dio-imerominies.html)

Αναζήτηση δεδομένων ανάμεσα σε δύο ημερομηνίες

Πως μπορώ να κάνω αναζήτηση των δεδομένων μου ανάμεσα σε δύο ημερομηνίες και να μου εμφανίζεται έπειτα μια λίστα με όλα τα δεδομένα που έχουν περαστεί σε αυτές τι ημερομηνίες;
Π.χ θέλω να κάνω μια αναζήτηση από τις 10/8/2017 μέχρι και σήμερα και να μου εμφανίσει όλα τα δεδομένα από τότε μέχρι σήμερα.

Η αναζήτηση θέλω να γίνεται χρησιμοποιώντας VBA κώδικα .

Έχω κάνει βέβαια μια προεργασία αλλά δέχεται μόνο μια ημερομηνία (η οποία βρίσκεται στο κελί H1) και ψάχνω τρόπο για το πως θα προσθέσω και την δεύτερη (η οποία βρίσκεται στο κελί I1) στον κώδικα έτσι ώστε να μου εμφανίζει τα δεδομένα από την 1η ημερομηνία μέχρι και την 2η.

Κώδικας:

Sub finddata()
 

'ΕΔΩ ΚΑΝΟΥΜΕ ΑΝΑΖΗΤΗΣΗ ΜΙΑ ΗΜΕΡΟΜΗΝΙΑ ΠΟΥ ΕΧΟΥΜΕ ΟΡΙΣΕΙ

Dim hmeromhnia As String

Dim finalrow As Integer

Dim i As Integer
 

If ActiveSheet.Cells(1, 8) = "" Then

    MsgBox "Δεν έχετε επιλέξει ημερομηνία." & vbCrLf & "Επιλέξτε την και δοκιμάστε πάλι.", vbExclamation

    ActiveSheet.Cells(1, 8).Select

    Exit Sub

End If
 

Sheets("ΑΡΧΕΙΟ").Range("I7:N1048576").ClearContents
 

hmeromhnia = Sheets("ΑΡΧΕΙΟ").Range("H1").Value

finalrow = Sheets("ΑΡΧΕΙΟ").Range("C1048576").End(xlUp).Row
 

For i = 2 To finalrow

    If Cells(i, 3) = hmeromhnia Then

        Range(Cells(i, 1), Cells(i, 6)).Copy

        Range("I1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats

        End If

Next i

        
 

End Sub

Γνωρίζει κανείς;

(Έψαξα και στο site αλλά από αυτά που βρήκα δεν μπόρεσα να καταλάβω κάτι.)

Στο συνημμένο τα δεδομένα βρίσκονται στο ΑΡΧΕΙΟ.

Ευχαριστώ εκ των προτέρων.

Καλημέρα

Βασίλη, δοκίμασε τον παρακάτω κώδικα.

Κώδικας:

'ΕΔΩ ΚΑΝΟΥΜΕ ΑΝΑΖΗΤΗΣΗ ΣΕ ΧΡΟΝΙΚΟ ΔΙΑΣΤΗΜΑ  ΠΟΥ ΕΧΟΥΜΕ ΟΡΙΣΕΙ

    Dim Apo As Date, Eos As Date

    Dim finalrow As Integer

    Dim i As Integer
 

    If Not IsDate(Cells(1, 8)) Then    'ημερομηνία έναρξης

        MsgBox "Δεν έχετε επιλέξει ημερομηνία." & vbCrLf & "Επιλέξτε την και δοκιμάστε πάλι.", vbExclamation

        Cells(1, 8).Select

        Exit Sub

    End If
 

    If Not IsDate(Cells(1, 9)) Then    'ημερομηνία λήξης

        MsgBox "Δεν έχετε επιλέξει ημερομηνία." & vbCrLf & "Επιλέξτε την και δοκιμάστε πάλι.", vbExclamation

        Cells(1, 9).Select

        Exit Sub

    End If

    Apo = Cells(1, 8).Value

    Eos = Cells(1, 9).Value
 
 

    Range("I7:N1048576").ClearContents
 

    finalrow = Range("C1048576").End(xlUp).Row
 

    For i = 2 To finalrow

        If Cells(i, 3) >= Apo And Cells(i, 3) <= Eos Then

            Range(Cells(i, 1), Cells(i, 6)).Copy

            Range("I1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats

        End If

    Next i

    Application.CutCopyMode = False

Στον κώδικα προσπάθησα να «πειράξω» το δικό σου όσο το δυνατόν λιγότερο.

Κάποιες απόψεις:

1) Όταν είναι γνωστή η ημερομηνία είναι επίσης γνωστά ο μήνας και η μέρα (μπορεί να προκύψουν από τύπους, κλπ) συνεπώς η επιλογή τους είναι και περιττή και μπορεί να οδηγήσει και σε σφάλματα ( η ημερομηνία να είναι Δευτέρα και να επιλεγεί Κυριακή).

2) Η χρήση κώδικα για να πετύχουμε κάτι που γίνεται εύκολα με τα εργαλεία του Excel, δεν είναι σωστή τακτική.

Εφαρμόζοντας το φίλτρο που φαίνεται στη συνημμένη εικόνα πετυχαίνουμε αυτό που θέλεις, χωρίς κώδικα, UserForm και ειδικά Controls.

Παράθεση:

Αρχική Δημοσίευση από kapetang (Μήνυμα 26766)

Καλημέρα

Βασίλη, δοκίμασε τον παρακάτω κώδικα.

Κώδικας:

'ΕΔΩ ΚΑΝΟΥΜΕ ΑΝΑΖΗΤΗΣΗ ΣΕ ΧΡΟΝΙΚΟ ΔΙΑΣΤΗΜΑ  ΠΟΥ ΕΧΟΥΜΕ ΟΡΙΣΕΙ

    Dim Apo As Date, Eos As Date

    Dim finalrow As Integer

    Dim i As Integer
 

    If Not IsDate(Cells(1, 8)) Then    'ημερομηνία έναρξης

        MsgBox "Δεν έχετε επιλέξει ημερομηνία." & vbCrLf & "Επιλέξτε την και δοκιμάστε πάλι.", vbExclamation

        Cells(1, 8).Select

        Exit Sub

    End If
 

    If Not IsDate(Cells(1, 9)) Then    'ημερομηνία λήξης

        MsgBox "Δεν έχετε επιλέξει ημερομηνία." & vbCrLf & "Επιλέξτε την και δοκιμάστε πάλι.", vbExclamation

        Cells(1, 9).Select

        Exit Sub

    End If

    Apo = Cells(1, 8).Value

    Eos = Cells(1, 9).Value
 
 

    Range("I7:N1048576").ClearContents
 

    finalrow = Range("C1048576").End(xlUp).Row
 

    For i = 2 To finalrow

        If Cells(i, 3) >= Apo And Cells(i, 3) <= Eos Then

            Range(Cells(i, 1), Cells(i, 6)).Copy

            Range("I1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats

        End If

    Next i

    Application.CutCopyMode = False

Γιώργο σε ευχαριστώ πάρα πολύ για την βοήθεια που μου παρείχες. Συμφωνώ με τα όσα λες, αλλά πιο συγκεκριμένα για τα εργαλεία προσπάθησα να προσθέσω κάτι φίλτρα για άμεση αναζήτηση αλλά δεν με βοήθησαν να κάνω αυτό που είχα κατά νου. Ο κώδικας που μου έστειλες όμως με βοήθησε να κάνω αυτό που ήθελα. Σε ευχαριστώ και πάλι. :027:

Να είσαι καλά!