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

Πώς να αντιγράψετε τη μορφοποίηση πηγής του κελιού αναζήτησης όταν χρησιμοποιείτε το Vlookup στο Excel;

Στα προηγούμενα άρθρα, έχουμε μιλήσει για τη διατήρηση του χρώματος φόντου όταν οι τιμές vlookup στο Excel. Εδώ σε αυτό το άρθρο, θα εισαγάγουμε μια μέθοδο αντιγραφής όλης της μορφοποίησης κελιού του κελιού που προκύπτει όταν κάνετε το Vlookup στο Excel. Κάντε τα εξής:

Αντιγραφή μορφοποίησης πηγής κατά τη χρήση του Vlookup στο Excel με μια λειτουργία που καθορίζεται από το χρήστη


Αντιγραφή μορφοποίησης πηγής κατά τη χρήση του Vlookup στο Excel με μια λειτουργία που καθορίζεται από το χρήστη

Ας υποθέσουμε ότι έχετε έναν πίνακα όπως φαίνεται παρακάτω το στιγμιότυπο οθόνης. Τώρα πρέπει να ελέγξετε εάν μια καθορισμένη τιμή (στη στήλη Ε) είναι στη στήλη Α και να επιστρέψετε την αντίστοιχη τιμή με τη μορφοποίηση στη στήλη Γ. Κάντε τα εξής για να το επιτύχετε.

1. Στο φύλλο εργασίας περιέχει την τιμή που θέλετε να δείτε, κάντε δεξί κλικ στην καρτέλα φύλλων και επιλέξτε Προβολή κωδικού από το μενού περιβάλλοντος. Δείτε το στιγμιότυπο οθόνης:

2. Στο άνοιγμα Microsoft Visual Basic για εφαρμογές παράθυρο, αντιγράψτε παρακάτω τον κώδικα VBA στο παράθυρο Κωδικός.

Κωδικός VBA 1: Vlookup και τιμή επιστροφής με μορφοποίηση

Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20211203
    Dim I As Long
    Dim xKeys As Long
    Dim xDicStr As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.CutCopyMode = False
    xKeys = UBound(xDic.Keys)
    If xKeys >= 0 Then
        For I = 0 To UBound(xDic.Keys)
            xDicStr = xDic.Items(I)
            If xDicStr <> "" Then
                Set xRg = Application.Range(xDicStr)
                xRg.Copy
                Range(xDic.Keys(I)).PasteSpecial xlPasteFormats
            Else
                Range(xDic.Keys(I)).Interior.Color = xlNone
            End If
        Next
        Set xDic = Nothing
    End If
    Application.ScreenUpdating = True
    Application.CutCopyMode = True
End Sub

3. Στη συνέχεια κάντε κλικ στο κουμπί Κύριο θέμα > Μονάδα μέτρησηςκαι αντιγράψτε τον παρακάτω κωδικό VBA 2 στο παράθυρο Module.

Κωδικός VBA 2: Vlookup και τιμή επιστροφής με μορφοποίηση

Public xDic As New Dictionary
'Update by Extendoffice 20211203
Function LookupKeepFormat(ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
    Dim xFindCell As Range
    On Error Resume Next
    Application.ScreenUpdating = False
    Set xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)
    If xFindCell Is Nothing Then
        LookupKeepFormat = " "
        xDic.Add Application.Caller.Address, " "
    Else
        LookupKeepFormat = xFindCell.Offset(0, xCol - 1).Value
        xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address(External:=True)
    End If
    Application.ScreenUpdating = True
End Function

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

5. Πάτα το άλλος + Q πλήκτρα για έξοδο από το Microsoft Visual Basic για εφαρμογές παράθυρο.

6. Επιλέξτε ένα κενό κελί δίπλα στην τιμή αναζήτησης και, στη συνέχεια, εισαγάγετε τον τύπο =LookupKeepFormat(E2,$A$1:$C$8,3) μέσα στο Φόρμουλα μπαρ, και στη συνέχεια πατήστε το εισάγετε κλειδί.

Note: Στον τύπο, E2 περιέχει την τιμή που θα αναζητήσετε, $ A $ 1: $ C $ 8 είναι το εύρος του πίνακα και ο αριθμός 3 σημαίνει ότι η αντίστοιχη τιμή που θα επιστρέψετε βρίσκεται στην τρίτη στήλη του πίνακα. Αλλάξτε τα όπως χρειάζεστε.

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


Σχετικά άρθρα:

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

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

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

kte καρτέλα 201905


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

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
Comments (43)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
So - this macro works, but every time I use it my spreadsheet stops responding for roughly 3 minutes (even for one single line of data). Any tips?
This comment was minimized by the moderator on the site
Is there a way to use this on the same sheet with two different lookups. Ie. Lookup Column M in array A:B, return column B with formatting. Then Lookup in Column N in array C:D and return column D with formatting?
Ive got the first set working perfectly, and the second set wont work at all. No error, just most of the rows are blank
This comment was minimized by the moderator on the site
This code only works when data is in same sheet.
This comment was minimized by the moderator on the site
Hi kirtiraj,To lookup values across worksheets and keep the formatting, you need to place the VBA code 1 in the code window of the result worksheet, and place the VBA code 2 in the Module code window.
This comment was minimized by the moderator on the site
I get a compile error: "Expected: end of statement", with the word "New" highlighted in: "Public xDic As New Dictionary".
I'm not a developer, just trying to solve a problem in a long set of sheets. So thank you for the help.
This comment was minimized by the moderator on the site
HeyThe code does not work in Microsoft Excel 2019 (16.0.13929.20360) 64-bit Can provide details if asked...
This comment was minimized by the moderator on the site
Please provide details
This comment was minimized by the moderator on the site
How to make this work if the value we are trying to look up sits in a different worksheet?
This comment was minimized by the moderator on the site
Hi,
To lookup values across worksheets and keep the formatting, you need to place the VBA code 1 in the code window of the result worksheet, and place the VBA code 2 in the Module code window.
This comment was minimized by the moderator on the site
That's Bad***!
Thanks for the coding and the tip on how to make the formula work across separate worksheets, friend.
However the coding should modified for the Subworksheet_Change for the one below:
Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20230328
Dim I As Long
Dim xKeys As Long
Dim xDicStr As String
On Error Resume Next
Application.ScreenUpdating = False
Application.CutCopyMode = False
Application.EnableEvents = False
xKeys = UBound(xDic.Keys)
If xKeys >= 0 Then
For I = 0 To UBound(xDic.Keys)
xDicStr = xDic.Items(I)
If xDicStr <> "" Then
Set xRg = Application.Range(xDicStr)
xRg.Copy
Range(xDic.Keys(I)).PasteSpecial xlPasteFormats
Else
Range(xDic.Keys(I)).Interior.Color = xlNone
End If
Next
Set xDic = Nothing
End If
Application.ScreenUpdating = True
Application.CutCopyMode = True
Application.EnableEvents = True
End Sub


If you combine the coding I wrote below for the Result worksheet and the coding provided here in the Module, it will work when using separate worksheets.
You'll thank me later!
Cheers
This comment was minimized by the moderator on the site
So, I got this to work. However, how I'm using it is I have the lookupkeepformat formula already entered in multiple rows. I then enter a letter (A-J) in column A and this letter tells the lookup formula which data I want. After it pulls the data, the cursor ends up in the cell where it finished entering the lookup data. How can I have the cursor return to column A?
This comment was minimized by the moderator on the site
I'm getting an error
This comment was minimized by the moderator on the site
I am adding these modules to my PERSONAL.XLSB file. I have Outlook 2016. And when I use this user-defined function, my excel doesn't crash or give an error. But it does not pull in the format of the source cell. It only pulls in the value. Since this function is located in the PERSONAL.XLSB file, my formula looks like this;=PERSONAL.xlsb!LookupKeepFormat(E2,$A$1:$C$8,3)
I had copied the code into 2 modules as directed, but this just doesn't work. Any ideas why?
This comment was minimized by the moderator on the site
I get the same Ambiguous name error - has anyone managed to solve it ?
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations