Εμφάνιση ενός μόνο μηνύματος
  #13  
Παλιά 12-09-11, 15:28
kapetang Ο χρήστης kapetang δεν είναι συνδεδεμένος
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.674
Προεπιλογή

Καλησπέρα στην παρέα

Λευτέρη, σ’ ευχαριστώ. Είσαι πολύ γενναιόδωρος. Με χαρά διαπιστώνω τη μεγάλη βελτίωσή σου τόσο στο excel όσο και στον τρόπου που παρουσιάζεις τις ιδέες σου.
Παίρνοντας αφορμή από την καταπληκτική λύση του Τάσου, στον εντοπισμό των γραμμών που μια δεδομένη στήλη τους περιέχει τη συμβολοσειρά αναζήτησης, προσπάθησα να βρω μια ανάλογη λύση χρησιμοποιώντας κώδικα.
Στο αρχείο που επισυνάπτω στο φύλλο «TEST» υπάρχει η λύση του Τάσου που υλοποιείται μόνο με συναρτήσεις του excel και στο φύλλο «VBA» μια λύση με κώδικα.
Ο κώδικας είναι σύντομος και φαίνεται παρακάτω:
Κώδικας:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x As Variant, j As Long, strS As String
    Dim LastRow As Long, col As New Collection
    
    If Application.Intersect(Target, Cells(2, 3)) Is Nothing Then Exit Sub
    Range("B4:G49").ClearContents
    If IsEmpty(Cells(2, 3)) Then Exit Sub
    strS = Cells(2, 3)
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row
    For j = 51 To LastRow
        If InStr(1, Cells(j, 3), strS, vbTextCompare) Then
            x = Range(Cells(j, 2), Cells(j, 7))
            col.Add x
        End If
    Next
    If col.Count = 0 Then Exit Sub
    Application.EnableEvents = False
    For j = 1 To col.Count
        Range("b" & 3 + j & ":G" & 3 + j) = col.Item(j)
    Next
    Application.EnableEvents = True
End Sub
Όταν οι γραμμές στο φύλλο δεδομένων είναι περιορισμένες δεν έχει σημασία ποια μέθοδος θα χρησιμοποιηθεί.
Όταν όμως έχουμε πολλές χιλιάδες γραμμών θα πρέπει να χρησιμοποιηθεί η ταχύτερη.
Κατά τη γνώμη μου, για να πούμε με σιγουριά ποια μέθοδος είναι ταχύτερη, θα πρέπει να γίνουν χρονομετρήσεις.
Ίσως βρεθεί κάποιο μέλος να δημιουργήσει εικονικές γραμμές και να πειραματιστεί.

Φιλικά/Γιώργος
Συνημμένα Αρχεία
Τύπος Αρχείου: xls xlSearchWildCardsVBA.xls (68,0 KB, 34 εμφανίσεις)
Απάντηση με παράθεση