Note: The other languages of the website are Google-translated. Back to English

Πώς να αντιγράψετε τη μορφοποίηση πηγής του κελιού αναζήτησης όταν χρησιμοποιείτε το 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 στο παράθυρο της ενότητας.

Κωδικός 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. Συνεχίστε να επιλέγετε το πρώτο κελί αποτελεσμάτων και, στη συνέχεια, σύρετε τη λαβή πλήρωσης προς τα κάτω για να λάβετε όλα τα αποτελέσματα μαζί με τη μορφοποίησή τους, όπως φαίνεται στο παρακάτω στιγμιότυπο οθόνης.


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


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

Το Kutools για Excel λύνει τα περισσότερα από τα προβλήματά σας και αυξάνει την παραγωγικότητά σας κατά 80%

  • Επαναχρησιμοποίηση: Εισαγάγετε γρήγορα σύνθετοι τύποι, γραφήματα και οτιδήποτε έχετε χρησιμοποιήσει στο παρελθόν. Κρυπτογράφηση κυττάρων με κωδικό πρόσβασης Δημιουργία λίστας αλληλογραφίας και στείλτε email ...
  • Super Formula Bar (επεξεργαστείτε εύκολα πολλές γραμμές κειμένου και τύπου). Διάταξη ανάγνωσης (εύκολη ανάγνωση και επεξεργασία μεγάλου αριθμού κελιών). Επικόλληση σε φιλτραρισμένο εύρος...
  • Συγχώνευση κελιών / σειρών / στηλών χωρίς απώλεια δεδομένων · Περιεχόμενο διαχωρισμού κελιών Συνδυάστε διπλές σειρές / στήλες... Αποτροπή διπλών κυττάρων; Συγκρίνετε τα εύρη...
  • Επιλέξτε Διπλότυπο ή Μοναδικό Σειρές; Επιλέξτε Κενές σειρές (όλα τα κελιά είναι κενά). Σούπερ εύρεση και ασαφής εύρεση σε πολλά βιβλία εργασίας. Τυχαία επιλογή ...
  • Ακριβές αντίγραφο Πολλαπλά κελιά χωρίς αλλαγή της αναφοράς τύπου. Αυτόματη δημιουργία αναφορών σε πολλαπλά φύλλα? Εισαγωγή κουκκίδων, Πλαίσια ελέγχου και άλλα ...
  • Εξαγωγή κειμένου, Προσθήκη κειμένου, Κατάργηση κατά θέση, Αφαιρέστε το διάστημα; Δημιουργία και εκτύπωση υποσύνολων σελιδοποίησης. Μετατροπή περιεχομένου και σχολίων μεταξύ κελιών...
  • Σούπερ φίλτρο (αποθηκεύστε και εφαρμόστε σχήματα φίλτρων σε άλλα φύλλα). Προηγμένη ταξινόμηση ανά μήνα / εβδομάδα / ημέρα, συχνότητα και άλλα. Ειδικό φίλτρο με έντονη, πλάγια ...
  • Συνδυάστε βιβλία εργασίας και φύλλα εργασίας; Συγχώνευση πινάκων βάσει βασικών στηλών. Διαχωρίστε τα δεδομένα σε πολλά φύλλα; Μαζική μετατροπή xls, xlsx και PDF...
  • Περισσότερα από 300 ισχυρά χαρακτηριστικά. Υποστηρίζει Office / Excel 2007-2021 και 365. Υποστηρίζει όλες τις γλώσσες. Εύκολη ανάπτυξη στην επιχείρηση ή τον οργανισμό σας. Πλήρεις δυνατότητες δωρεάν δοκιμής 30 ημερών. Εγγύηση επιστροφής χρημάτων 60 ημερών.
kte καρτέλα 201905

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

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
κάτω μέρος γραφείου
Σχόλια (42)
Δεν υπάρχουν ακόμη βαθμολογίες. Γίνε ο πρώτος που θα αξιολογήσετε!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
μου δίνει Σφάλμα μεταγλώττισης, Σφάλμα Σύνταξης

παρακαλώ βοηθήστε
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Καλή μέρα,
Ο κώδικας έχει ενημερωθεί στο άρθρο. Σας ευχαριστούμε για το σχόλιό σας.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Μου ήρθε και το σφάλμα μεταγλωττιστή.
Διορθώνεται εάν αλλάξετε την ακόλουθη μεταβλητή με το πραγματικό "". Οχι ';' στη μέση.
LookupKeepFormat = " "
xDic.Add Application.Caller.Address, " "
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας,
Συγγνώμη για το λάθος, ο κώδικας έχει ενημερωθεί στο άρθρο.
Το λάθος " " πρέπει να είναι δύο εισαγωγικά " ". Σας ευχαριστούμε για το σχόλιό σας.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Έλαβα το ίδιο σφάλμα.

Θα πρέπει να αλλάξετε το " " για το πραγματικό "", χωρίς ";" όπως υποδεικνύεται παρακάτω
LookupKeepFormat = " "
xDic.Add Application.Caller.Address, " "

LookupKeepFormat = ""
xDic.Add Application.Caller.Address ""
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας,
Συγγνώμη για το λάθος, ο κώδικας έχει ενημερωθεί στο άρθρο. Σε ευχαριστώ που μοιράστηκες.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Αυτό είναι υπέροχο, ευχαριστώ! Το μόνο πρόβλημα είναι ότι βρίσκω ότι λειτουργεί καλά, αν ψάχνω στο ίδιο φύλλο, αλλά δεν μπορώ να το κάνω να λειτουργήσει όταν προσπαθώ να κάνω μια αναζήτηση σε ξεχωριστό φύλλο στα δεδομένα προέλευσης. Θα συνεχίσει να προσπαθεί
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Τζούλια, διόρθωσε αυτές τις γραμμές:
στο Function LookupKeepFormat:
xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Διεύθυνση & "|" & LookupRng.Parent.Name

στο Subsheet_Change:
Φύλλα(Split(xDic.Items(I), "|")(1)).Range(Split(xDic.Items(I), "|")(0)).Αντιγραφή
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Ούγκο,


Έχω το ίδιο πρόβλημα με την Τζούλια. Δεν λειτουργεί σε άλλα φύλλα. Θα μπορούσατε να βοηθήσετε στη σύνταξη κώδικα για ολόκληρη τη συνάρτηση και το δευτερεύον φύλλο εργασίας; Δεν είμαι σίγουρος πού να αντικαταστήσω/εισαγάγω το xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Διεύθυνση & "|" & LookupRng.Parent.Nam and Sheets(Split(xDic.Items(I), "|")(1)).Range(Split(xDic.Items(I), "|")(0)).Αντιγραφή


ευχαριστώ σε αντάλλαγμα
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Εκτιμώ ιδιαίτερα τη συνέχεια Hugo!
Δυστυχώς, όπως ο Vi, είμαι πολύ αρχάριος για να καταλάβω πού να εισαγάγω τις προτεινόμενες διορθώσεις κώδικα...

Ευχαριστώ και πάλι, καλή σου μέρα :)
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου


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

Δεν λαμβάνω σφάλματα και κάνει την αναζήτηση, αλλά επειδή η τιμή αναζήτησης βρίσκεται σε άλλο φύλλο εργασίας (πιθανότερο σενάριο), δεν τραβάει τη μορφοποίηση. Υπάρχει κάποια τροποποίηση στον κώδικα που μπορώ να κάνω για αυτό; (Να είστε πολύ συγκεκριμένοι ως προς το πού πρέπει να γίνει η αλλαγή καθώς είμαι αρχάριος στον κώδικα) Ευχαριστώ! Είμαι ενθουσιασμένος που προσθέτω αυτή τη δυνατότητα σε ένα από τα υπολογιστικά φύλλα μου!!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, καλή τύχη σε αυτήν την ερώτηση, πώς μπορούμε να αναζητήσουμε τη μορφοποίηση σε φύλλα;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Επιδιώκει επίσης το tweak.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Επίσης, εάν προσθέσω τον τύπο σας ως μέρος μιας δήλωσης "Εάν" (δείτε παρακάτω), μορφοποιεί το κελί όπως θέλει LOL (ή τουλάχιστον έτσι φαίνεται. Σε ένα κελί, το κείμενο έγινε σκιερό και έντονο με ένα επάνω περίγραμμα στο το κελί, ένα άλλο κελί, το κείμενο στο κέντρο)


=IF($F19 = "", "",LookupKeepFormat(F19,'Στοιχείο #s'!$A$1:$M$1226,2))
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Δοκίμασα αυτό και αυτό που τραβάει μόνο το έγχρωμο φόντο και λαμβάνω το ίδιο σφάλμα. Σφάλμα μεταγλώττισης: Εντοπίστηκε διφορούμενο όνομα. Κάνω κλικ στο OK και επισημαίνει το xDic. Οποιεσδήποτε προτάσεις? Δεν είμαι πολύ εξοικειωμένος με όλα αυτά, οπότε παρακαλώ βοηθήστε/εξηγήστε :) ευχαριστώ εκ των προτέρων
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Jeni,
Μην ξεχάσετε να ενεργοποιήσετε την επιλογή Microsoft Script Runtime όπως αναφέρεται στο βήμα 4.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Χαίρετε. Δημιούργησα ένα κενό υπολογιστικό φύλλο και αντιγράψαμε το παράδειγμά σας στο Excel 2013, αλλά συνεχίστε να λαμβάνετε ένα σφάλμα μεταγλώττισης: Σφάλμα σύνταξης και το Dim I As Long επισημαίνεται. Υπάρχει κάτι που μου λείπει; Θα ήθελα πολύ να λειτουργήσει αυτό. Ευχαριστώ.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια Λάουρα,
Μην ξεχάσετε να ενεργοποιήσετε την επιλογή Microsoft Script Runtime όπως αναφέρεται στο βήμα 4.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, χρησιμοποιούσα τον παραπάνω κώδικα στο Excel 2010 χωρίς προβλήματα μέχρι σήμερα. Ωστόσο, πρόσφατα αναβαθμίστηκα στο Office 2016 και τώρα ο κώδικας διακόπτει το Excel κάθε φορά που προσπαθώ να συμπληρώσω περισσότερες από μία σειρές. Δυστυχώς, δεν μου δίνει άλλο σφάλμα εκτός από το "Microsoft Excel έχει σταματήσει να λειτουργεί". Αναρωτιόμουν αν είχατε συναντήσει αυτό το ζήτημα στο παρελθόν και αν πρέπει να κάνω κάτι για να λειτουργήσει το 2016. Ευχαριστώ!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σου Leigh,
Ο κώδικας λειτουργεί καλά στο Excel 2016 μου. Προσπαθούμε να αναβαθμίσουμε τον κώδικα για να λύσουμε το πρόβλημα. Σας ευχαριστούμε για το σχόλιό σας.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, ευχαριστώ για τον κωδικό. Δεν λαμβάνω κανένα μήνυμα σφάλματος, αλλά ο τύπος λειτουργεί μόνο όπως ένα κανονικό vlookup. Μπορείτε παρακαλώ να βοηθήσετε; Ευχαριστώ για τον χρόνο σου.
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας

Έχω ακριβώς το ίδιο θέμα, καταλάβατε πώς να το λύσω;

Ευχαριστώ!
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
γεια, έλαβα το σφάλμα "Σφάλμα μεταγλώττισης: Εντοπίστηκε διφορούμενο όνομα: xDic
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
γεια, έλαβα το σφάλμα "Σφάλμα μεταγλώττισης: Εντοπίστηκε διφορούμενο όνομα: xDic
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Γεια σας, Είμαι νέος στη χρήση του VBA και προσπάθησα να χρησιμοποιήσω αυτόν τον κώδικα στο υπολογιστικό φύλλο μου, αλλά η μορφοποίηση κειμένου στην καρτέλα Rec2 δεν μεταβαίνει στην καρτέλα Rec όταν χρησιμοποιείται η αναζήτηση. Οποιαδήποτε βοήθεια θα εκτιμηθεί ιδιαίτερα. Ευχαριστώ Pat
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Εδώ είναι το αρχείο και η φωτογραφία
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Λαμβάνω το ίδιο σφάλμα διφορούμενου ονόματος - κατάφερε κανείς να το λύσει;
Αυτό το σχόλιο ελαχιστοποιήθηκε από τον συντονιστή του ιστότοπου
Λαμβάνω το ίδιο σφάλμα διφορούμενου ονόματος - κατάφερε κανείς να το λύσει;
Δεν υπάρχουν σχόλια δημοσιεύτηκε ακόμα
Τοποθετήστε Περισσότερα
Αφήστε τα σχόλιά σας
Δημοσίευση ως επισκέπτης
×
Αξιολογήστε αυτήν την ανάρτηση:
0   Χαρακτήρες
Προτεινόμενες τοποθεσίες

Ακολουθησε μας

Πνευματικά δικαιώματα © 2009 - www.extendoffice.com. | Ολα τα δικαιώματα διατηρούνται. Τροφοδοτείται από ExtendOffice. | Sitemap
Το Microsoft και το λογότυπο του Office είναι εμπορικά σήματα ή σήματα κατατεθέντα της Microsoft Corporation στις Ηνωμένες Πολιτείες ή / και σε άλλες χώρες.
Προστατεύεται από το Sectigo SSL