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

كيفية البحث عن لون الخلفية وإرجاعه مع قيمة البحث في Excel؟

لنفترض أن لديك جدولًا كما هو موضح أدناه. الآن تريد التحقق مما إذا كانت القيمة المحددة موجودة في العمود A ثم إرجاع القيمة المقابلة مع لون الخلفية في العمود C. كيف تحقق ذلك؟ يمكن أن تساعدك الطريقة الواردة في المقالة في حل المشكلة.

Vlookup وإرجاع لون الخلفية مع قيمة البحث بواسطة وظيفة معرّفة من قبل المستخدم


Vlookup وإرجاع لون الخلفية مع قيمة البحث بواسطة وظيفة معرّفة من قبل المستخدم


يرجى القيام بما يلي للبحث عن قيمة وإرجاع قيمتها المقابلة مع لون الخلفية في Excel.

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

2. في الافتتاح ميكروسوفت فيسوال باسيك للتطبيقات نافذة ، يرجى نسخ رمز VBA أدناه في نافذة التعليمات البرمجية.

كود VBA 1: Vlookup وإرجاع لون الخلفية بقيمة البحث

Sub Worksheet_Change(ByVal Target As Range)
    Dim I As Long
    Dim xKeys As Long
    Dim xDicStr As String
    On Error Resume Next
    Application.ScreenUpdating = False
    xKeys = UBound(xDic.Keys)
    If xKeys >= 0 Then
        For I = 0 To UBound(xDic.Keys)
            xDicStr = xDic.Items(I)
            If xDicStr <> "" Then
                Range(xDic.Keys(I)).Interior.Color = _
                Range(xDic.Items(I)).Interior.Color
            Else
                Range(xDic.Keys(I)).Interior.Color = xlNone
            End If
        Next
        Set xDic = Nothing
    End If
    Application.ScreenUpdating = True
End Sub

3. ثم اضغط إدراج > وحدة، وانسخ رمز VBA 2 أدناه في نافذة الوحدة النمطية.

كود VBA 2: Vlookup وإرجاع لون الخلفية بقيمة البحث

Public xDic As New Dictionary
Function LookupKeepColor (ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
    Dim xFindCell As Range
    On Error Resume Next
    Set xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)
    If xFindCell Is Nothing Then
        LookupKeepColor = ""
        xDic.Add Application.Caller.Address, ""
    Else
        LookupKeepColor = xFindCell.Offset(0, xCol - 1).Value
        xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address
    End If
End Function

4. بعد إدخال الرمزين ، انقر فوق أدوات > مراجع. ثم تحقق من ملف وقت تشغيل البرنامج النصي لـ Microsoft في مربع المراجع - VBAProject صندوق المحادثة. انظر لقطة الشاشة:

5. اضغط على قديم + Q مفاتيح للخروج من ميكروسوفت فيسوال باسيك للتطبيقات نافذة والعودة إلى ورقة العمل.

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

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

7. استمر في تحديد خلية النتيجة الأولى ، واسحب مقبض التعبئة لأسفل للحصول على جميع النتائج مع لون الخلفية. انظر لقطة الشاشة.


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


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

Kutools for Excel يحل معظم مشاكلك ويزيد إنتاجيتك بنسبة 80٪

  • إعادة استخدام: أدخل بسرعة الصيغ المعقدة والرسوم البيانية وأي شيء استخدمته من قبل ؛ تشفير الخلايا مع كلمة السر إنشاء قائمة بريدية وإرسال رسائل البريد الإلكتروني ...
  • سوبر فورميولا بار (بسهولة تحرير أسطر متعددة من النص والصيغة) ؛ تخطيط القراءة (قراءة وتحرير أعداد كبيرة من الخلايا بسهولة) ؛ لصق في النطاق المصفى
  • دمج الخلايا / الصفوف / الأعمدة دون فقدان البيانات ؛ تقسيم محتوى الخلايا ؛ ادمج الصفوف / الأعمدة المكررة... منع تكرار الخلايا؛ قارن النطاقات
  • حدد مكرر أو فريد صفوف حدد صفوف فارغة (جميع الخلايا فارغة) ؛ البحث الفائق والبحث الغامض في العديد من المصنفات. تحديد عشوائي ...
  • نسخة طبق الأصل خلايا متعددة بدون تغيير مرجع الصيغة ؛ إنشاء المراجع تلقائيًا إلى أوراق متعددة أدخل الرموز النقطية، مربعات الاختيار والمزيد ...
  • استخراج النص، إضافة نص ، إزالة حسب الموضع ، إزالة الفضاء؛ إنشاء وطباعة المجاميع الفرعية لترحيل الصفحات ؛ التحويل بين محتوى الخلايا والتعليقات
  • سوبر تصفية (حفظ وتطبيق مخططات التصفية على أوراق أخرى) ؛ فرز متقدم حسب الشهر / الأسبوع / اليوم ، التكرار والمزيد ؛ مرشح خاص بواسطة bold، italic ...
  • اجمع بين المصنفات وأوراق العمل؛ دمج الجداول على أساس الأعمدة الرئيسية ؛ تقسيم البيانات إلى أوراق متعددة; تحويل دفعة xls و xlsx و PDF
  • أكثر من 300 ميزة قوية. يدعم Office / Excel 2007-2019 و 365. يدعم جميع اللغات. سهولة النشر في مؤسستك أو مؤسستك. الميزات الكاملة نسخة تجريبية مجانية لمدة 30 يومًا. ضمان استرداد الأموال لمدة 60 يومًا.
علامة تبويب kte 201905

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

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
أوفيسيتاب القاع
فرز التعليقات حسب
التعليقات (32)
تقييم شنومك من شنومكس · تصنيفات 1
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كيف أقوم بتغيير هذا الرمز لاستخراج لون الخلفية من ورقة أخرى؟
على سبيل المثال ، أود استخدام VLOOKUP في الورقة 2 ، والذي يستخرج البيانات ولون الخلفية من الورقة 1.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لدي نفس السؤال بالضبط! أي نصيحة سيكون موضع تقدير كبير.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أود أيضًا استخدام VLOOKUP في الورقة 2 واستخراج البيانات ولون الخلفية من الورقة 1
تم تصغير هذا التعليق بواسطة المشرف على الموقع
استخدم هذا التعديل الطفيف للرمز المنشور.


xDic العام مثل قاموس جديد
عامة strWB كسلسلة
الضوابط العامة كسلسلة

وظيفة CLookup (ByRef FndValue، ByRef LookupRng كنطاق، ByRef xCol As Long)
خافت xFindCell كمدى
على خطأ استئناف التالي

strWB = LookupRng.Parent.Parent.Name '*** تذكر المصنف من أين تأتي البيانات والألوان
strWS = LookupRng.Parent.Name '*** تذكر ورقة العمل من أين تأتي البيانات والألوان

تعيين xFindCell = LookupRng.Find (FndValue،، xlValues، xlWhole)

إذا كان xFindCell لا شيء إذن
CLookup = ""
xDic.Add Application.Caller.Address، ""
آخر
CLookup = xFindCell.Offset (0، xCol - 1). القيمة
xDic.Add Application.Caller.Address، xFindCell.Offset (0، xCol - 1). Address

إنهاء حالة
نهاية وظيفة

Sub Worksheet_Change (ByVal Target As Range)
أنا خافت وطويلة
خافت xKeys طويلة
خافت xDicStr كسلسلة
خافت rngLoc كمجموعة
على خطأ استئناف التالي
Application.ScreenUpdating = خطأ
xKeys = UBound (xDic.Keys)
إذا كان xKeys> = 0 ثم
بالنسبة إلى I = 0 إلى UBound (xDic.Keys)
xDicStr = xDic.Items (I)
إذا كان xDicStr <> "" ثم
النطاق (xDic.Keys (I)). Interior.Color = Application.Workbooks (strWB) .Worksheets (strWS) .Range (xDic.ems (I)). Interior.Color
آخر
النطاق (xDic.Keys (I)). Interior.Color = xlNone
إنهاء حالة
التالى
تعيين xDic = لا شيء
إنهاء حالة
Application.ScreenUpdating = ترو
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل هذا لإصلاح خطأ في الكود الأصلي أم أن هذا يسمح له بالبحث عن ورقة مختلفة؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
يتيح لك هذا التغيير في الكود الأصلي إجراء vlookup w / color من ورقة عمل إلى أخرى أو من مصنف إلى آخر. لكن يجب وضع هذا الرمز في ورقة العمل TARGET بدلاً من ورقة عمل SOURCE كما هو موضح في الكود الأصلي. هذا لأن الكود الأصلي يعمل فقط في ورقة عمل واحدة ، لذلك كان كلا من المصدر والهدف. هذا ليس إصلاحًا للرمز الأصلي. لقد أضفت للتو رمزًا للسماح لك بالسحب من أي مصنف / ورقة عمل (مصدر) إلى ورقة العمل (الهدف). عمل الكود الأصلي كما أراد المبرمج.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، لقد فعلت ذلك الإجراء ولكن لا يمكنني إحضار لون الخلفية في ورقة العمل الجديدة ، لدي شك إذا وضعت بطريقة صحيحة أمر strWB و strWS لقد وضعت هذا strWB = LookupRng.Reporte_Opcionales
strWS = LookupRng.Imprimir Reporte_Opcionales هو اسم المصنف الخاص بي
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أعتقد أن الخطوط من المفترض أن تكون كما يلي (بالضبط):

strWB = LookupRng.Parent.Parent.Name

strWS = LookupRng.Parent.Name


لقد توصلت إلى هذا منذ حوالي 4 أشهر ، لذا لا أتذكر بالضبط كيف توصلت إلى هذا ، لكن لم يكن من المفترض أن تستبدل هذا الرمز بأي شيء آخر.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
ما الاسم في strWB يتكرر Parent.Parent ؟؟؟؟ هل هذا صحيح؟
ويرجع الفضل في ذلك مسبقا.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
بوب ، ساعدني من فضلك ، كولود يرجى التحقق من الرمز؟ أنا متأكد من أنه يمكنك إصلاحه لأنه يجعل لون الخلفية من ورقة أخرى.

بالمناسبة ، يعمل الكود المخصص للعمل في نفس الورقة ولكني أحتاج إلى إحضار البيانات من ورقة أخرى :(.

شكرا مقدما
تحيات مونتيري المكسيك.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هذا يعمل بشكل رائع ، شكرا لك!
تقييم شنومك من شنومكس
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هذا الكود يعمل على نفس الورقة ، كيف يمكنني البحث عن لون من ورقة إلى أخرى؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
استخدم هذا التعديل الطفيف للرمز المنشور.


xDic العام مثل قاموس جديد
عامة strWB كسلسلة
الضوابط العامة كسلسلة

وظيفة CLookup (ByRef FndValue، ByRef LookupRng كنطاق، ByRef xCol As Long)
خافت xFindCell كمدى
على خطأ استئناف التالي

strWB = LookupRng.Parent.Parent.Name '*** تذكر المصنف من أين تأتي البيانات والألوان
strWS = LookupRng.Parent.Name '*** تذكر ورقة العمل من أين تأتي البيانات والألوان

تعيين xFindCell = LookupRng.Find (FndValue،، xlValues، xlWhole)

إذا كان xFindCell لا شيء إذن
CLookup = ""
xDic.Add Application.Caller.Address، ""
آخر
CLookup = xFindCell.Offset (0، xCol - 1). القيمة
xDic.Add Application.Caller.Address، xFindCell.Offset (0، xCol - 1). Address

إنهاء حالة
نهاية وظيفة

Sub Worksheet_Change (ByVal Target As Range)
أنا خافت وطويلة
خافت xKeys طويلة
خافت xDicStr كسلسلة
خافت rngLoc كمجموعة
على خطأ استئناف التالي
Application.ScreenUpdating = خطأ
xKeys = UBound (xDic.Keys)
إذا كان xKeys> = 0 ثم
بالنسبة إلى I = 0 إلى UBound (xDic.Keys)
xDicStr = xDic.Items (I)
إذا كان xDicStr <> "" ثم
النطاق (xDic.Keys (I)). Interior.Color = Application.Workbooks (strWB) .Worksheets (strWS) .Range (xDic.ems (I)). Interior.Color
آخر
النطاق (xDic.Keys (I)). Interior.Color = xlNone
إنهاء حالة
التالى
تعيين xDic = لا شيء
إنهاء حالة
Application.ScreenUpdating = ترو
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا بوب! تعمل الكود ، مع ذلك ، لسبب ما ، فهي تنسخ القيم من الورقة 2 إلى الورقة 1 ، ولكنها تنسخ تنسيق الخلية وتتركها في الورقة 2 ... يصعب شرحها ، لكنها تقسم إجراءً واحدًا بشكل أساسي (نسخ نص + تكوين نسخة ولصقه في الخلية) في قسمين. هل تعرف كيف تجعلها تفعل كلاهما على ورقة واحدة؟ شكرًا لك!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
يعمل هذا الرمز على نفس الورقة ولكن كيف يمكنني البحث عن لون الخلية من ورقة إلى ورقة أخرى في Excel
ويرجع الفضل في تقدم :)
تم تصغير هذا التعليق بواسطة المشرف على الموقع
استخدم هذا التعديل الطفيف للرمز المنشور.


xDic العام مثل قاموس جديد
عامة strWB كسلسلة
الضوابط العامة كسلسلة

وظيفة CLookup (ByRef FndValue، ByRef LookupRng كنطاق، ByRef xCol As Long)
خافت xFindCell كمدى
على خطأ استئناف التالي

strWB = LookupRng.Parent.Parent.Name '*** تذكر المصنف من أين تأتي البيانات والألوان
strWS = LookupRng.Parent.Name '*** تذكر ورقة العمل من أين تأتي البيانات والألوان

تعيين xFindCell = LookupRng.Find (FndValue،، xlValues، xlWhole)

إذا كان xFindCell لا شيء إذن
CLookup = ""
xDic.Add Application.Caller.Address، ""
آخر
CLookup = xFindCell.Offset (0، xCol - 1). القيمة
xDic.Add Application.Caller.Address، xFindCell.Offset (0، xCol - 1). Address

إنهاء حالة
نهاية وظيفة

Sub Worksheet_Change (ByVal Target As Range)
أنا خافت وطويلة
خافت xKeys طويلة
خافت xDicStr كسلسلة
خافت rngLoc كمجموعة
على خطأ استئناف التالي
Application.ScreenUpdating = خطأ
xKeys = UBound (xDic.Keys)
إذا كان xKeys> = 0 ثم
بالنسبة إلى I = 0 إلى UBound (xDic.Keys)
xDicStr = xDic.Items (I)
إذا كان xDicStr <> "" ثم
النطاق (xDic.Keys (I)). Interior.Color = Application.Workbooks (strWB) .Worksheets (strWS) .Range (xDic.ems (I)). Interior.Color
آخر
النطاق (xDic.Keys (I)). Interior.Color = xlNone
إنهاء حالة
التالى
تعيين xDic = لا شيء
إنهاء حالة
Application.ScreenUpdating = ترو
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لدي نوافذ لنظام التشغيل Mac ، عندما أصل إلى الخطوة 4 - لا يوجد خيار لـ Microsoft Scripting Runtime ، هل هناك شيء آخر يجب أن أختاره؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
عندما أقوم بفتح نافذة عرض الكود ، توجد نافذة ولكنها ليست فارغة. هل يمكنني لصق الرمز أسفل النص الموجود بالفعل أو كيف يمكنني فتح "صفحة فارغة" جديدة من فضلك؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أنا أعيد قيمة ، لكني لا أحصل على اللون. استخدم الورقة إلى رمز الورقة ، متبوعًا بـ T. أي أفكار حول سبب عدم الحصول على اللون؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل هناك أي طريقة لتعديل هذا لاستخدامه كبرنامج Hlookup؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مساء الخير بوب لهذه الرموز يمكنك تغييرها بالإضافة إلى اللون اتصل بي نفس تنسيق اللون والخط الذي يحتوي على الخلية

شكراً لك
تم تصغير هذا التعليق بواسطة المشرف على الموقع
يعمل هذا بشكل جيد في Office 2010 ، ولكن ليس إصدار 2013. هل هناك تحديث للماكرو؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، هل يمكنني تطبيق vlookup على خلايا اللون التي لا تحتوي على بيانات
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أحصل على لون الخلية المطلوب ولكني أحتاج أيضًا إلى قيمة البحث لأنها تُرجع عددًا صحيحًا بدلاً من السلسلة
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لقد استخدمت هذا في Excel 2016 ويتم نقل البيانات فقط من المصدر إلى الهدف ... ... لا يتم نقل اللون. أفكار حول المشكلة التي قد تكون: هل هي عدم التوافق مع Excel 2016؟ شكرًا. MT
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كان هذا رائعًا! اتبعت الخطوات وهي تعمل بشكل جميل! شكرًا لك!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لدي العديد من السجلات ، وتستغرق المعالجة وقتًا طويلاً ، ويستمر تشغيل الرمز حتى بعد الانتهاء. الرجاء المساعدة
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، لدي ورقة بها 10,948 صفًا ، يستغرق الأمر بعض الوقت لسحب المعلومات بالألوان ، وما زلت في الانتظار. هل هذا طبيعي أم أن هناك خطأ ما؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كيف افعل
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أستخدم الأوقات والتواريخ من تقارير Excel لإنشاء جداول زمنية لموظفينا. إذا كان التاريخ المحدد ، على سبيل المثال ، 2020/08/11 يطابق التاريخ الموجود في صفيف علامات التبويب التالية (التي تحتوي على العديد من الخلايا بنفس التاريخ ولكن بأوقات مختلفة) ، فأنا أريدها أن تسحب فقط الخلية المملوءة باللون البرتقالي والتي سيتم ذكرها على أنها 2020/08/11 7:45. هل هذا ممكن؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، هل هذا الرمز يعمل مع Office 2016 والإصدارات الأحدث؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لا ، لا يعود لونه.
لا توجد تعليقات منشورة هنا حتى الآن
اترك تعليقاتك
النشر كضيف
×
قيم المنشور:
0   الشخصيات
المواقع المقترحة