Μετάβαση στο κύριο περιεχόμενο

Πώς να δείτε και να επιστρέψετε πολλές τιμές χωρίς διπλότυπα στο Excel; 

Συγγραφέας: Xiaoyang Τελευταία τροποποίηση: 2018-05-03

Μερικές φορές, μπορεί να θέλετε να δείτε και να επιστρέψετε πολλές αντιστοιχισμένες τιμές σε ένα κελί ταυτόχρονα. Αλλά, εάν υπάρχουν μερικές επαναλαμβανόμενες τιμές που συμπληρώνονται στα επιστρεφόμενα κελιά, πώς θα μπορούσατε να αγνοήσετε τα διπλότυπα και να διατηρήσετε μόνο τις μοναδικές τιμές όταν επιστρέφετε όλες τις αντίστοιχες τιμές όπως ακολουθεί το στιγμιότυπο οθόνης που εμφανίζεται στο Excel;

doc επιστρέφει πολλές μοναδικές τιμές 1

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


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

Ο παρακάτω κώδικας VBA μπορεί να σας βοηθήσει να επιστρέψετε πολλές τιμές αντιστοίχισης χωρίς διπλότυπα, κάντε το ως εξής:

1. Κρατήστε πατημένο το Alt + F11 για να ανοίξετε το Microsoft Visual Basic για εφαρμογές παράθυρο.

2. Κλίκ Κύριο θέμα > Μονάδα μέτρησηςκαι επικολλήστε τον ακόλουθο κώδικα στο Μονάδα μέτρησης Παράθυρο.

Κωδικός VBA: Vlookup και επιστροφή πολλαπλών μοναδικών αντιστοιχισμένων τιμών:

Function MultipleLookupNoRept(Lookupvalue As String, LookupRange As Range, ColumnNumber As Integer)
    Dim xDic As New Dictionary
    Dim xRows As Long
    Dim xStr As String
    Dim i As Long
    On Error Resume Next
    xRows = LookupRange.Rows.Count
    For i = 1 To xRows
        If LookupRange.Columns(1).Cells(i).Value = Lookupvalue Then
            xDic.Add LookupRange.Columns(ColumnNumber).Cells(i).Value, ""
        End If
    Next
    xStr = ""
    MultipleLookupNoRept = xStr
    If xDic.Count > 0 Then
        For i = 0 To xDic.Count - 1
            xStr = xStr & xDic.Keys(i) & ","
        Next
        MultipleLookupNoRept = Left(xStr, Len(xStr) - 1)
    End If
End Function

3. Αφού εισαγάγετε τον κωδικό, κάντε κλικ στο Εργαλεία > αναφορές στο άνοιξε Microsoft Visual Basic για εφαρμογές παράθυρο, και στη συνέχεια, στο αναδυόμενο Αναφορές - VBAProject πλαίσιο διαλόγου, επιλέξτε Χρόνος εκτέλεσης δέσμης ενεργειών Microsoft επιλογή του Διαθέσιμες αναφορές πλαίσιο λίστας, δείτε το στιγμιότυπο οθόνης:

doc επιστρέφει πολλές μοναδικές τιμές 2

4. Στη συνέχεια κάντε κλικ στο κουμπί OK για να κλείσετε το παράθυρο διαλόγου, να αποθηκεύσετε και να κλείσετε το παράθυρο κώδικα, να επιστρέψετε στο φύλλο εργασίας και να εισαγάγετε αυτόν τον τύπο: =MultipleLookupNoRept(E2,A2:C17,3) σε ένα κενό κελί όπου θέλετε να εξάγετε το αποτέλεσμα, πατήστε εισάγετε κλειδί για να έχετε το σωστό αποτέλεσμα όπως χρειάζεστε. Δείτε στιγμιότυπο οθόνης:

doc επιστρέφει πολλές μοναδικές τιμές 3

Note: Στον παραπάνω τύπο, E2 είναι τα κριτήρια που θέλετε να vlookup, Α2: Γ17 είναι το εύρος δεδομένων που θέλετε να χρησιμοποιήσετε, ο αριθμός 3 είναι ο αριθμός στήλης που περιέχει τις επιστρεφόμενες τιμές.

Τα καλύτερα εργαλεία παραγωγικότητας γραφείου

🤖 Kutools AI Aide: Επανάσταση στην ανάλυση δεδομένων με βάση: Ευφυής Εκτέλεση   |  Δημιουργία κώδικα  |  Δημιουργία προσαρμοσμένων τύπων  |  Αναλύστε δεδομένα και δημιουργήστε γραφήματα  |  Επίκληση Λειτουργιών Kutools...
Δημοφιλή χαρακτηριστικά: Εύρεση, επισήμανση ή αναγνώριση διπλότυπων   |  Διαγραφή κενών γραμμών   |  Συνδυάστε στήλες ή κελιά χωρίς απώλεια δεδομένων   |   Γύρος χωρίς φόρμουλα ...
Σούπερ Αναζήτηση: VLookup πολλαπλών κριτηρίων    VLookup πολλαπλών τιμών  |   VLookup σε πολλά φύλλα   |   Ασαφής αναζήτηση ....
Σύνθετη αναπτυσσόμενη λίστα: Γρήγορη δημιουργία αναπτυσσόμενης λίστας   |  Εξαρτημένη αναπτυσσόμενη λίστα   |  Πολλαπλή αναπτυσσόμενη λίστα ....
Διαχειριστής στήλης: Προσθέστε έναν συγκεκριμένο αριθμό στηλών  |  Μετακίνηση στηλών  |  Εναλλαγή κατάστασης ορατότητας κρυφών στηλών  |  Συγκρίνετε εύρη και στήλες ...
Επιλεγμένα Χαρακτηριστικά: Εστίαση πλέγματος   |  Προβολή σχεδίου   |   Μεγάλη Formula Bar    Διαχείριση βιβλίου εργασίας & φύλλου   |  Βιβλιοθήκη πόρων (Αυτόματο κείμενο)   |  Επιλογή ημερομηνίας   |  Συνδυάστε φύλλα εργασίας   |  Κρυπτογράφηση/Αποκρυπτογράφηση κελιών    Αποστολή email ανά λίστα   |  Σούπερ φίλτρο   |   Ειδικό φίλτρο (φίλτρο με έντονη γραφή/πλάγια γραφή/διαγραφή...) ...
Κορυφαία 15 σύνολα εργαλείων12 Κείμενο Εργαλεία (Προσθήκη κειμένου, Κατάργηση χαρακτήρων, ...)   |   50 + Διάγραμμα Τύποι (Gantt διάγραμμα, ...)   |   40+ Πρακτικό ΜΑΘΗΜΑΤΙΚΟΙ τυποι (Υπολογίστε την ηλικία με βάση τα γενέθλια, ...)   |   19 Εισαγωγή Εργαλεία (Εισαγωγή κωδικού QR, Εισαγωγή εικόνας από το μονοπάτι, ...)   |   12 Μετατροπή Εργαλεία (Αριθμοί σε λέξεις, Μετατροπή Συναλλάγματος, ...)   |   7 Συγχώνευση & διαχωρισμός Εργαλεία (Σύνθετες σειρές συνδυασμού, Διαίρεση κελιών, ...)   |   ... κι αλλα

Αυξήστε τις δεξιότητές σας στο Excel με τα Kutools για Excel και απολαύστε την αποτελεσματικότητα όπως ποτέ πριν. Το Kutools για Excel προσφέρει πάνω από 300 προηγμένες δυνατότητες για την ενίσχυση της παραγωγικότητας και την εξοικονόμηση χρόνου.  Κάντε κλικ εδώ για να αποκτήσετε τη δυνατότητα που χρειάζεστε περισσότερο...

Περιγραφή


Το Office Tab φέρνει τη διεπαφή με καρτέλες στο Office και κάνει την εργασία σας πολύ πιο εύκολη

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
Comments (13)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
This is great! How would I adapt this to not add null values to the dictionary? I've tried adding the bold below, but the final string is still returning with ,"", instances.


xRows = LookupRange.Rows.Count
For i = 1 To xRows
If LookupRange.Columns(1).Cells(i).Value = Lookupvalue And Not IsEmpty(LookupRange.Columns(1).Cells(i).Value) Then
xDic.Add LookupRange.Columns(ColumnNumber).Cells(i).Value, ""
End If
Next

Thanks,
This comment was minimized by the moderator on the site
Hello , I did as u told and it great but it still havent solve one of my problem , what happen when u unique value in each month ? =MultipleLookupNoRept(E2,A2:C17,3) , i try to E2&1 for January but it not working
This comment was minimized by the moderator on the site
Hi, Jame,
Could you give your problem as a screenshot here, so that i can understand your requires?
This comment was minimized by the moderator on the site
hi,
while the time of lot value multivlooks my worksheet got hang.is there any other ways to multivlookupwithoutrepeation????

and also i used on new desktop also its getting hang only...

my data value is around 10,000 rows
This comment was minimized by the moderator on the site
Hi

I wanted to create a list in a table from this instead of all results in one cell. So I have used a formula similar below (what you have suggested)

=LOOKUP(2, 1/((COUNTIF($E$1:E1, $B$2:$B$12)=0)*($D$2=$A$2:$A$12)), $B$2:$B$12)

However, this is taking a long time to process from a large set of data.
Is there any alternative method to process this faster?
Thanks again
Rasike
This comment was minimized by the moderator on the site
xStr = xStr & xDic.Keys(I) & "," to be this: xStr = xStr & xDic.Keys(I) & ", "

Is there a way to replace "," with in-cell ALT+ENTER, so that the results will be in the same cell but on different lines? Do I need to introduce additional VBA module for that and combine them?

Also, this code is quite slow when looping over huge tables. Anyone knows any faster solutions?
This comment was minimized by the moderator on the site
Hi, Imre,
To separate the result values by Alt + Enter keys, please apply the following User Defined Function:

Function MultipleLookupNoRept(Lookupvalue As String, LookupRange As Range, ColumnNumber As Integer)
Dim xDic As New Dictionary
Dim xRows As Long
Dim xStr As String
Dim i As Long
On Error Resume Next
xRows = LookupRange.Rows.Count
For i = 1 To xRows
If LookupRange.Columns(1).Cells(i).Value = Lookupvalue Then
xDic.Add LookupRange.Columns(ColumnNumber).Cells(i).Value, ""
End If
Next
xStr = ""
MultipleLookupNoRept = xStr
If xDic.Count > 0 Then
For i = 0 To xDic.Count - 1
xStr = xStr & xDic.Keys(i) & Chr(10) + Chr(13)
Next
MultipleLookupNoRept = Left(xStr, Len(xStr) - 1)
End If
Debug.Print xStr
End Function

And then do with the above steps in this article, at last, after entering the formula, you should click Wrap Text under the Home tab.
This comment was minimized by the moderator on the site
Is there a way to add a space in between the multiple values retrieved in the results without introducing a comma at the end of the list? For example your result above would show as: "Emily, James, Daisy, Gary" instead of like this: "Emily,James,Daisy,Gary"

I tried to edit this portion of the VBA code: xStr = xStr & xDic.Keys(I) & "," to be this: xStr = xStr & xDic.Keys(I) & ", "

That did add the space in between the values, but it also added a comma after the last value. "Emily, James, Daisy, Gary,"

Is there a way to make it work with the space but without the extra comma after the last value?
This comment was minimized by the moderator on the site
Hello, Demetre,
Use the space to separate the values, you just need to change the vba code:
from xStr = xStr & xDic.Keys(i) & "," to be this: xStr = xStr & xDic.Keys(i) & " "

Please try it.
This comment was minimized by the moderator on the site
what if I wanted to create a list in a table from this instead of all results in one cell?
This comment was minimized by the moderator on the site
Hello, Tom,
If you want to extract the unique values in a list of cells instead of one cell, the following formula may help you:

=LOOKUP(2, 1/((COUNTIF($E$1:E1, $B$2:$B$12)=0)*($D$2=$A$2:$A$12)), $B$2:$B$12)

Please try it.
This comment was minimized by the moderator on the site
Hi skyyang what if you want the result as a column?
This comment was minimized by the moderator on the site
Hi Skyyang,

Thank you very much for this formula.
This works for me. However, it is taking a long time to process from a large set of data.
Can we modify this formula to work this bit faster?
Thanks again
Rasike
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations