Επιστροφή στο Forum : Αναζήτηση πολλαπλών στοιχείων στο Ms Excel - Help
Καλημέρα στην παρέα.
Εχω ένα πρόβλημα στο Ms Excel και ζητάω την βοήθεια όποιου φίλου γνωρίζει.
Εχω μία λίστα στο Excell με 4 – 5 χιλιάδες σειρές, που η κάθε μία έχει 30 πεδία.
Κάθε μέρα, μου δίνουν μια λίστα με 100 – 150 κωδικούς, τους οποίους πρέπει να τους ψάξω στο excel, να μαρκάρω ΟΛΗ την γραμμή που περιέχει τον κωδικό, να την μεταφέρω σε ένα ΝΕΟ φύλο excel και έτσι να δημιουργήσω μια νέα λίστα excel από τους κωδικούς που μου δίνουν και να στείλω την νέα λίστα με email.
Υπάρχει κάποιο macro ή κάποιο πρόγραμμα, που να διαβάζει την λίστα με τους κωδικούς και μετά να τους ψάχνει ΟΛΟΥΣ μαζί στην μεγάλη λίστα excel ?? Να κάνει select ολες τις γραμμές στην μεγάλη λίστα, ώστε να μπορώ με την μία να τις κάνω copy σε νέο excel ας πούμε.
Ευχαριστώ για τον χρόνο σας.
Σωτήρη για να πετύχεις όλο αυτό που ζητάς, χρειάζεται σίγουρα κάποιο VBScript, και όχι macro.
Αυτό που μπορώ να σου προτείνω είναι να πας σε ένα άλλο φύλλο του αρχείου και να παίξεις
με την εντολή VLOOKUP(), ώστε τουλάχιστον να γλυτώσεις από τα Find, αλλά στο τέλος για
καινούριο αρχείο θα πρέπει να παίξει copy/paste!
ΥΓ. Μπορεί να σου ακουστεί χαζό, αλλά εαν πρόκειται να γίνεται συχνά αυτή η ιστορία
σκέψου το ενδεχόμενο να μάθεις Access! Το excel δεν βοηθάει και πολύ όταν χρησιμοποιείται
σαν βάση δεδομένων, και απλές ενέργειες γίνονται εκνευριστικά περίπλοκες! (παθών)
Δυστηχώς, δεν έχω την παραμικρή ιδέα απο VBScript....
Γι αυτό το λόγο ψάχνω κάτι έτοιμο.
Αν βρείς κάτι, πες μου σε παρακαλώ γιατι έχω πήξει.
Χάνω 2 ώρες την ημέρα σε αναζήτηση και αντιγραφή.
Εστω οτι εχεις ενα 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
Χρήστο ευχαριστώ πολύ για την βοήθεια.
Το Vbasic δεν φαίνεται να λειτουργει σωστά, γιατι το πεδίο που αναζητώ στην μεγάλη λίστα δέν βρίσκετε πάντα στην πρώτη στήλη.
Μπορεί να βρίσκετε οπουδήποτε μέσα στην λίστα.
Μπορείς να κάνεις την αλαγή αυτή ??
Και πάλι, χιλια ευχαριστώ.
Μπορω, αλλα μιας και τα data δεν ειναι normalized, το αποτελεσμα δεν θα ειναι εγγυημενο (πιθανοτητα διπλων εγγραφων, ωρα για να τελειωσει...)
Τελως παντων, θα σου ανεβασω σε λιγο το "updated version" :)
Τουλαχιστον το ζητουμενο ειναι μονο του σε ενα κελι, ή μπορει να ειναι μαζι και με αλλα data ?
Το ζητούμενο είναι Μόνο σε ένα κελι στον μεγάλο πίνακα.
Η ταχύτητα δεν είναι θέμα. Εδώ κάνω καμιά ώρα να το κάνω χειροκίνητα...
Και τις διπλές εγραφες τισ κανονίζω μετά.
και πάλι ευχαριστώ.
Τι να σε κανω...
Εχε χαρη που εισαι φιλος του Στεφανου, συναδελφος και πανω απ`ολα εχεις το ονομα του γιου μου :)
Για κοιτα το παρακατω αν σε βολευει.
το μεγαλο 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
Τι να σε κανω...
Εχε χαρη που εισαι φιλος του Στεφανου, συναδελφος και πανω απ`ολα εχεις το ονομα του γιου μου :)
Για κοιτα το παρακατω αν σε βολευει.
Τζίφος Χρήστο.
Δεν ξέρω τι γίνετε. Δεν βρίσκει ουτε μία εγραφή. Δεν μπορώ να καταλάβω τι συμβαίνει.
Το script φαίνεται να τρέχει. Βγάζει κλεψύδρα για αρκετά δευτερόλεπτα αλλα μετά τίποτα.
Ουτε λάθη βγάζει ουτε τίποτα...
:(
Σε παιρνει να βαλεις ενα δειγμα, εστω και με ψευτικες τιμες?
Χρήστο, τελικά παρ' ολο που δούλεψε κάποια στιγμή, παρουσιάζει περίεργη συμπεριφορά.
Τώρα που προσπαθώ να το τρέξω ξανά με νέο σέτ κλειδιών προς αναζήτηση, δεν επιστρέφει τίποτα...
Το κοιταω, θα σου απαντησω.
Μεχρι τοτε ...χειρονακτικη εργασια.
Κατι αλλο:
Αυτο φαινεται να βγαινει απο καποια βαση (RDBMS)
Αν εχω δικιο, μπορεις να βγαλεις το αποτελεσμα απο εκει, πιο γρηγορα και αναιμακτα.
Άλλη λύση εφόσον δεν θέλεις να κάνεις vb ή access(sql):
βημα 1:
Κάνεις save ολο το αρχείο από το excel, σαν arxeio.csv (comma separated list).
βημα 2:
Δίνεις από command prompt (κονσόλα):
find "αυτόΠουΨάχνεις" arxeio.csv > results.csv
Αν έχεις και άλλες αναζητήσεις να κάνεις, επαναλαμβάνεις το βήμα 2, αλλά προσοχή με την εντολή
find "αυτόΠουΨάχνεις" arxeio.csv >> results.csv
βήμα 3:
και το results.csv το ανοίγεις μετά στο excel.
Αλλη ιδεα:
Αν μπορεις οντως να τα κανεις csv κι εχεις access σε καποιο *NIX
τοτε:
for i in `cat key_file.csv`
do
grep -i "$i" big_excel.csv >> output.csv
done
Τελικά το θέμα λύθηκε χάρη στις προγραμματιστικές ικανότητες και την υπομονη του Χρήστου.
και πάλι χιλια ευχαριστώ.
Σωτήρη,
Μιας και εγκυκλοπαιδικά με ενδιαφέρει η λύση που δόθηκε, θα μπορούσες να μας επισυνάψεις το τελικά διαμορφωμένο VB Script?
Χρήστο, πιστευω ότι δεν σε πειράζει να δημοσιευσω το VBScript, οπότε και το βάζω στη απάντηση...
Option Explicit
Sub Sotiris3()
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
'cols1 = Sheet1.Range(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.Range("B" & i).Value = Sheet2.Range("A" & k).Value Then
If LTrim(RTrim(Sheet1.Cells(i, m).Value)) = LTrim(RTrim(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
Ευχαριστώ και τους δυο σας
LOL
Φυσικα και οχι. :)
Το ειδα κι εχτες, κι ειπα να το ανεβασω εγω, αλλα μετα εμπλεξα με την δουλεια και το ξεχασα...
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.