انتقل إلى المحتوى الرئيسي

كيفية نسخ تنسيق المصدر لخلية البحث عند استخدام Vlookup في Excel؟

في المقالات السابقة ، تحدثنا عن الحفاظ على لون الخلفية عند قيم vlookup في Excel. هنا في هذه المقالة ، سنقدم طريقة لنسخ جميع تنسيقات الخلية للخلية الناتجة عند إجراء Vlookup في Excel. الرجاء القيام بما يلي.

نسخ تنسيق المصدر عند استخدام Vlookup في Excel مع وظيفة محددة من قبل المستخدم


نسخ تنسيق المصدر عند استخدام Vlookup في Excel مع وظيفة محددة من قبل المستخدم

لنفترض أن لديك جدولًا كما هو موضح أدناه. أنت الآن بحاجة إلى التحقق مما إذا كانت القيمة المحددة (في العمود E) موجودة في العمود A وإرجاع القيمة المقابلة بالتنسيق في العمود C. يرجى القيام بما يلي لتحقيق ذلك.

1. في ورقة العمل تحتوي على القيمة التي تريد مشاهدتها ، انقر بزر الماوس الأيمن فوق علامة تبويب الورقة وحدد عرض الرمز من قائمة السياق. انظر لقطة الشاشة:

2. في الافتتاح ميكروسوفت فيسوال باسيك للتطبيقات نافذة ، يرجى نسخ رمز 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 مفاتيح للخروج من ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

6. حدد خلية فارغة مجاورة لقيمة البحث ، ثم أدخل الصيغة =LookupKeepFormat(E2,$A$1:$C$8,3) في شريط الفورمولا، ثم اضغط على أدخل الرئيسية.

ملاحظات: في الصيغة ، E2 يحتوي على القيمة التي ستبحث عنها ، 1 دولار أسترالي: 8 دولارات كندية هو نطاق الجدول والرقم 3 يعني أن القيمة المقابلة التي ستعيدها تقع في العمود الثالث من الجدول. يرجى تغييرها كما تريد.

7. استمر في تحديد خلية النتيجة الأولى ، ثم اسحب مقبض التعبئة لأسفل للحصول على جميع النتائج جنبًا إلى جنب مع التنسيق كما هو موضح أدناه.


مقالات ذات صلة:

أفضل أدوات إنتاجية المكتب

🤖 مساعد Kutools AI: إحداث ثورة في تحليل البيانات على أساس: التنفيذ الذكي   |  إنشاء التعليمات البرمجية  |  إنشاء صيغ مخصصة  |  تحليل البيانات وإنشاء الرسوم البيانية  |  استدعاء وظائف Kutools...
الميزات الشعبية: البحث عن التكرارات أو تمييزها أو تحديدها   |  حذف الصفوف الفارغة   |  دمج الأعمدة أو الخلايا دون فقدان البيانات   |   جولة بدون صيغة 
سوبر بحث: معايير متعددة VLookup    VLookup ذات القيمة المتعددة  |   VLookup عبر أوراق متعددة   |   بحث غامض ....
قائمة منسدلة متقدمة: إنشاء القائمة المنسدلة بسرعة   |  القائمة المنسدلة التابعة   |  قائمة منسدلة متعددة التحديد ....
مدير العمود: إضافة عدد محدد من الأعمدة  |  نقل الأعمدة  |  تبديل حالة رؤية الأعمدة المخفية  |  مقارنة النطاقات والأعمدة 
الميزات المميزة: التركيز على الشبكة   |  عرض تصميم   |   شريط الفورمولا الكبير    مدير المصنفات والأوراق   |  مكتبة الموارد (النص السيارات)   |  منتقي التاريخ   |  اجمع أوراق العمل   |  تشفير/فك تشفير الخلايا    إرسال رسائل البريد الإلكتروني عن طريق القائمة   |  سوبر تصفية   |   مرشح خاص (تصفية غامق / مائل / يتوسطه خط ...) ...
أفضل 15 مجموعة أدوات12 نص الأدوات (إضافة نص, إزالة الأحرف، ...)   |   +50 رسم الأنواع (مخطط جانت، ...)   |   40+ عملي الصيغ (احسب العمر على أساس تاريخ الميلاد، ...)   |   19 إدخال الأدوات (أدخل رمز الاستجابة السريعة, إدراج صورة من المسار، ...)   |   12 تحويل الأدوات (أرقام إلى كلمات, نتيجة تحويل عملة، ...)   |   7 دمج وتقسيم الأدوات (الجمع بين الصفوف المتقدمة, تقسيم الخلايا، ...)   |   ... و اكثر

عزز مهاراتك في Excel باستخدام Kutools for Excel، واختبر كفاءة لم يسبق لها مثيل. يقدم Kutools for Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية وتوفير الوقت.  انقر هنا للحصول على الميزة التي تحتاجها أكثر...

الوصف


يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
Comments (44)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
It seems to work but excel freezes from it and goes unresponsive. HELP!!!!
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?
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