Forum - Excel07 Βοήθεια με αναζήτηση

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

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

- - [Excel07] Βοήθεια με αναζήτηση (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/2834-boitheia-me-anazitisi.html)

Καλησπέρα!

Δείτε μια προσέγγιση με φόρμα αναζήτησης στο συνημμένο παρακάτω.

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

Ανοίγοντας τη φόρμα, στο πλαίσιο λίστας εμφανίζονται οι εγγραφές του φύλλου "Data".
Οι εγγραφές που καταχωρούνται ή ήδη έχουν καταχωρηθεί επισημαίνονται στη δεξιά στήλη του πλαισίου.
Μπορεί να αναζητηθεί οποιοδήποτε τμήμα του κωδικού ή της περιγραφής του προϊόντος.
Για επιτευχθεί αυτό έχουν προστεθεί 2 στήλες στο φύλλο "Data".

Χρήση:

Ανοίξτε τη φόρμα είτε με το πλήκτρο F3 κουμπί στο φύλλο "Form".
Το πλήκτρο F3 μεταφέρει την εστίαση στη φόρμα αν η δεύτερη είναι ανοικτή.
Πληκτρολογήστε το κείμενο αναζήτησης. Στο πλαίσιο λίστας θα συμπληρωθούν αυτόματα οι εγγραφές που σχετίζονται με το κριτήριο που πληκτρολογήσατε.
Πατήστε Enter για να μεταφερθείτε στο πλαίσιο λίστας.
Επιλέξτε το επιθυμητό στοιχείο και καταχωρήστε το στη φόρμα παραγγελίας είτε με Enter είτε με διπλό κλικ.

Το πλαίσιο ελέγχου στη φόρμα θα σας βοηθήσει να ελέγξετε τη μεταφορά εστίασης από τη φόρμα αναζήτησης στο φύλλο μετά από κάθε καταχώρηση.

Μπορείτε να χρησιμοποιήσετε τον τροχό του ποντικιού για την κύλιση του πλαισίου λίστας.

Προσέξτε τα ονόματα και τους τύπους που χρησιμοποιούνται στο βιβλίο αυτό.

Τάσος

Τασο δεν ξερω τι να πω!!!!ποιο να πρωτο διαλεξω!!!!!πραγματικα εισαι απιστευτος!!!!!!

Τασο ομως εχει ενα θεμα.πως ο χρηστης δεν θα μπορει να πληκτρολογισει κατι στις Β9- Ε143 γιατι αμα γραψεις κατι εκει θα βγαλει προβλημα

Τασο καλημερα και χρονια πολλα.
Επειδη θελω να παραμετροποιησω αυτο που εκανες και για αλλη δουλεια.Μπορεις να με βοηθησεις λιγο?
Σε ποιο σημειο του κωδικα θα αλλαξω την εκκαθαριση των κελιων? δηλαδη δεν θελω να καθαριζει τις στηλες H και Ι
Δεν μπορεσα να βρω την ακρη!!

Καλημέρα!

Για να πληκτρολογείς ή να συμπληρώνεις αυτόματα στις στήλες Β9:Ε143 δηλαδή να μην χρησιμοποιείς τύπους:

Διέγραψε τους τύπους που περιέχουν
Φρόντισε να τα κελιά αυτά να μην είναι προστατευμένα
Αντικατέστησε όλο τον κώδικα της εντολής Private Sub InsertListRow() με τον παρακάτω:

Κώδικας:

Private Sub InsertListRow()

    Dim c As Range

    If Me.ListBox1.ListCount = 0 Then Exit Sub

    If Me.ListBox1.ListIndex = -1 Then Exit Sub

    Set c = Range("OrderCodes").Find(Me.ListBox1.Value, LookIn:=xlValues)

    If Not c Is Nothing Then GoTo ExitHere

    With Cells(Rows.Count, Range("OrderCodes").Column).End(xlUp).Offset(1)

        .Value = Me.ListBox1.Value

        .Offset(, 1).Value = ShData.Cells(Me.ListBox1.ListIndex + 2, 4).Value

        .Offset(, 2).Value = ShData.Cells(Me.ListBox1.ListIndex + 2, 5).Value

        .Offset(, 3).Value = ShData.Cells(Me.ListBox1.ListIndex + 2, 6).Value

        .Offset(, 4).Value = ShData.Cells(Me.ListBox1.ListIndex + 2, 7).Value

        Cells(.Row, 8).Select

        If Me.ChckFocusAfterNewEntry Then

            AppActivate Application.Caption

        End If

    End With

ExitHere:

    With Me.ListBox1

        If .List(.ListIndex, 2) = ItmIsMissing Then

            .List(.ListIndex, 2) = ItmExists

        End If

    End With

    If Not c Is Nothing Then

        Cells(c.Row, 8).Select

    End If

End Sub

Επίσης θα χρειαστεί να αντικαταστήσεις την εντολή Private Sub cmdClearAll_Click() με τον παρακάτω κώδικα:

Κώδικας:

Private Sub cmdClearAll_Click()

    Range("OrderCodes").Resize(Range("OrderCodes").Count, 7).ClearContents

    TextBox1_Change

    Me.Height = 223

    Me.ListBox1.Enabled = True

    Me.TextBox1.Enabled = True

    Me.cmdClear.Enabled = True

    Me.cmdClearOrderList.Enabled = True

    Me.ChckFocusAfterNewEntry.Enabled = True

    Me.TextBox1.SetFocus

End Sub

Καλή συνέχεια!

Τάσος