Αναζήτηση πολλαπλών στοιχείων στο Ms Excel - Help

[SV1JRT]

Καλημέρα στην παρέα.
Εχω ένα πρόβλημα στο Ms Excel και ζητάω την βοήθεια όποιου φίλου γνωρίζει.

Εχω μία λίστα στο Excell με 4 – 5 χιλιάδες σειρές, που η κάθε μία έχει 30 πεδία.
Κάθε μέρα, μου δίνουν μια λίστα με 100 – 150 κωδικούς, τους οποίους πρέπει να τους ψάξω στο excel, να μαρκάρω ΟΛΗ την γραμμή που περιέχει τον κωδικό, να την μεταφέρω σε ένα ΝΕΟ φύλο excel και έτσι να δημιουργήσω μια νέα λίστα excel από τους κωδικούς που μου δίνουν και να στείλω την νέα λίστα με email.

Υπάρχει κάποιο macro ή κάποιο πρόγραμμα, που να διαβάζει την λίστα με τους κωδικούς και μετά να τους ψάχνει ΟΛΟΥΣ μαζί στην μεγάλη λίστα excel ?? Να κάνει select ολες τις γραμμές στην μεγάλη λίστα, ώστε να μπορώ με την μία να τις κάνω copy σε νέο excel ας πούμε.
Ευχαριστώ για τον χρόνο σας.

[kplgr]

Σωτήρη για να πετύχεις όλο αυτό που ζητάς, χρειάζεται σίγουρα κάποιο VBScript, και όχι macro.

Αυτό που μπορώ να σου προτείνω είναι να πας σε ένα άλλο φύλλο του αρχείου και να παίξεις
με την εντολή VLOOKUP(), ώστε τουλάχιστον να γλυτώσεις από τα Find, αλλά στο τέλος για
καινούριο αρχείο θα πρέπει να παίξει copy/paste!

ΥΓ. Μπορεί να σου ακουστεί χαζό, αλλά εαν πρόκειται να γίνεται συχνά αυτή η ιστορία
σκέψου το ενδεχόμενο να μάθεις Access! Το excel δεν βοηθάει και πολύ όταν χρησιμοποιείται
σαν βάση δεδομένων, και απλές ενέργειες γίνονται εκνευριστικά περίπλοκες! (παθών)

[SV1JRT]

Δυστηχώς, δεν έχω την παραμικρή ιδέα απο VBScript....
Γι αυτό το λόγο ψάχνω κάτι έτοιμο.
Αν βρείς κάτι, πες μου σε παρακαλώ γιατι έχω πήξει.
Χάνω 2 ώρες την ημέρα σε αναζήτηση και αντιγραφή.

[bchris]

Εστω οτι εχεις ενα sheet (sheet1) καπως ετσι:

A____B____C (column names)
a......1.......a (data)
ab.....2.......b
abc...3.......c
ac.....4.......d
b.......5......e
bc.....6.......f
bb.....7.......g
bcd....8......h

Οπου προφανως ειναι το μεγαλο sheet με τα 5000 rows.
και το sheet(sheet2) με τους κωδικους σου:

A____B____C (column names)
1
2
3

Τοτε με το παρακατω vb script, κανεις την δουλεια σου:

Option Explicit

Sub Sotiris()
    Dim lastRow1 As Long, lastRow2 As Long, i As Long, k As Long
    Dim CopyRange As Range

    With Sheets("Sheet1")
        lastRow1 = .Range("A" & .Rows.Count).End(xlUp).Row
        With Sheets("Sheet2")
            lastRow2 = .Range("A" & .Rows.Count).End(xlUp).Row
            
            For i = 1 To lastRow1
                For k = 1 To lastRow2
                    If Sheet1.Range("B" & i).Value = Sheet2.Range("A" & k).Value Then
                        If CopyRange Is Nothing Then
                            Set CopyRange = Sheet1.Rows(i)
                        Else
                            Set CopyRange = Union(CopyRange, Sheet1.Rows(i))
                        End If
                    End If
                Next
            Next

        If Not CopyRange Is Nothing Then
            CopyRange.Copy Sheets("Sheet3").Rows(1)
        End If
        End With
    End With
End Sub

[SV1JRT]

Χρήστο ευχαριστώ πολύ για την βοήθεια.
Το Vbasic δεν φαίνεται να λειτουργει σωστά, γιατι το πεδίο που αναζητώ στην μεγάλη λίστα δέν βρίσκετε πάντα στην πρώτη στήλη.
Μπορεί να βρίσκετε οπουδήποτε μέσα στην λίστα.
Μπορείς να κάνεις την αλαγή αυτή ??
Και πάλι, χιλια ευχαριστώ.

[bchris]

Μπορω, αλλα μιας και τα data δεν ειναι normalized, το αποτελεσμα δεν θα ειναι εγγυημενο (πιθανοτητα διπλων εγγραφων, ωρα για να τελειωσει...)

Τελως παντων, θα σου ανεβασω σε λιγο το "updated version"

Τουλαχιστον το ζητουμενο ειναι μονο του σε ενα κελι, ή μπορει να ειναι μαζι και με αλλα data ?

[SV1JRT]

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

[bchris]

Τι να σε κανω...

Εχε χαρη που εισαι φιλος του Στεφανου, συναδελφος και πανω απ`ολα εχεις το ονομα του γιου μου

Για κοιτα το παρακατω αν σε βολευει.

το μεγαλο sheet:

a    1    a
ab    2    b
3    abc    c
ac    4    d
5    b    e
bc    6    f
bb    7    g
8    bcd    h

to allo:

1
3
5
8

kai to VB Script:

Option Explicit

Sub Sotiris2()
    Dim lastRow1 As Long, lastRow2 As Long, i As Long, k As Long, m As Integer, cols1 As Long
    Dim CopyRange As Range

    With Sheets("Sheet1")
        lastRow1 = .Range("A" & .Rows.Count).End(xlUp).Row
        cols1 = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
        With Sheets("Sheet2")
            lastRow2 = .Range("A" & .Rows.Count).End(xlUp).Row
            
            For i = 1 To lastRow1
                For k = 1 To lastRow2
                    For m = 1 To cols1
                        If Sheet1.Cells(i, m).Value = Sheet2.Range("A" & k).Value Then
                            If CopyRange Is Nothing Then
                                Set CopyRange = Sheet1.Rows(i)
                            Else
                                Set CopyRange = Union(CopyRange, Sheet1.Rows(i))
                            End If
                        End If
                    Next
                Next
            Next

        If Not CopyRange Is Nothing Then
            CopyRange.Copy Sheets("Sheet3").Rows(1)
        End If
        End With
    End With
End Sub

[SV1JRT]

Τι να σε κανω...

Εχε χαρη που εισαι φιλος του Στεφανου, συναδελφος και πανω απ`ολα εχεις το ονομα του γιου μου

Για κοιτα το παρακατω αν σε βολευει.

Τζίφος Χρήστο.
Δεν ξέρω τι γίνετε. Δεν βρίσκει ουτε μία εγραφή. Δεν μπορώ να καταλάβω τι συμβαίνει.
Το script φαίνεται να τρέχει. Βγάζει κλεψύδρα για αρκετά δευτερόλεπτα αλλα μετά τίποτα.
Ουτε λάθη βγάζει ουτε τίποτα...

[bchris]

Σε παιρνει να βαλεις ενα δειγμα, εστω και με ψευτικες τιμες?