اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

مساعدة في كود VLOOKUP


الردود الموصى بها

السلام عليكم ورحمة الله وبركاته

اخواني الكرام

من فضلكم تعديل كود (vlookup) للاخ والمعلم أبو احمد (أ.عبدالله المجرب ) في احدي المشاركات قمت بتعديله بما يتناسب طلبي والحمد لله مضبوط لكن المشكلة عندي عندما لا يكون مقابل نتيجة للبحث تظهر علامة (N/A#) فبرجاء التعديل الكود حتي لا يظهر في الخلايا وجزاكم الله كل خير

الكود


Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

Set MyRng = Sheets("DATA").[A1:AG1000]

If Not Intersect(Target, [B8]) Is Nothing Then

Cells(Target.Row + 3, 2) = Application.VLookup(Target, MyRng, 2, 0)

Cells(Target.Row + 4, 2) = Application.VLookup(Target, MyRng, 20, 0)

Cells(Target.Row + 5, 2) = Application.VLookup(Target, MyRng, 27, 0)

Cells(Target.Row + 6, 2) = Application.VLookup(Target, MyRng, 6, 0)

Cells(Target.Row + 7, 2) = Application.VLookup(Target, MyRng, 4, 0)

Cells(Target.Row + 8, 2) = Application.VLookup(Target, MyRng, 12, 0)

Cells(Target.Row + 9, 2) = Application.VLookup(Target, MyRng, 7, 0)


Cells(Target.Row + 11, 2) = Application.VLookup(Target, MyRng, 23, 0)

Cells(Target.Row + 12, 2) = Application.VLookup(Target, MyRng, 24, 0)

Cells(Target.Row + 13, 2) = Application.VLookup(Target, MyRng, 25, 0)

Cells(Target.Row + 14, 2) = Application.VLookup(Target, MyRng, 26, 0)

Cells(Target.Row + 16, 2) = Application.VLookup(Target, MyRng, 18, 0)

Cells(Target.Row + 17, 2) = Application.VLookup(Target, MyRng, 33, 0)

Cells(Target.Row + 18, 2) = Application.VLookup(Target, MyRng, 19, 0)

Cells(Target.Row + 19, 2) = Application.VLookup(Target, MyRng, 22, 0)


End If

End Sub

رابط هذا التعليق
شارك

ألسلام عليكم

جرب هكذا


Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

Set MyRng = Sheet2.[A1:AG1000]

If Not Intersect(Target, [B8]) Is Nothing Then

With Application

For i = 1 To 35

C = Choose(i, 3, 4, 5, 6, 7, 8, 9, 11, 12, 13, 14, 16, 17, 18, 19)

Cr = Choose(i, 2, 20, 27, 6, 4, 12, 7, 23, 24, 25, 26, 18, 33, 19, 22)

If C = Null Or Cr = Null Then GoTo 0

Cells(Target.Row + C, 2) = IIf(IsError(.VLookup(Target, MyRng, Cr, 0)), "", .VLookup(Target, MyRng, Cr, 0))

0 Next

End With

Set MyRng = Nothing

End If

End Sub

تم تعديل بواسطه عباد
رابط هذا التعليق
شارك

السلام عليكم ورحمة الله وبركاته

أخي الكريم الاستاذ عباد أبو نصار مايســترو الأكواد

كل اعمالك بها افكار جميلة

كودك اكثر من رائع

جزاك الله خيرا وبارك الله لك

تقبل تحياتي

اخوك / ضاحي الغريب

رابط هذا التعليق
شارك

اخي الاستاذ / عباد أبو نصار

الكود جميل وفهمت فكرته لكن الجزء التالي ارجو شرحه



For i = 1 To 35

جزاك الله خيرا عما تقدمه لنا من عون ومساعدة وجعله في ميزان حسناتك

رابط هذا التعليق
شارك

السلام عليكم

الأخ الفاضل ضاحي الغريب

اشكرك على كلامك الطيب


For i = 1 To 35

حلقة بقدر أكبر رقم حسب السطر الذي لديك

Cells(Target.Row + 17, 2) = Application.VLookup(Target, MyRng, 33, 0)

أرجو أن تكون أتضحت لدبك الصوره

تقبل تحياتي

رابط هذا التعليق
شارك

السلام عليكم ورحمة الله وبركاته

الأخ الكريم أ. عباد أبو نصار

أستاذن منك ولي طلب أخر وشكرك مسبقا

عندي معادلة في الخلية (B28) لايجاد صلاحية الاقامة من خلية التاريخ (B25) بالشكل التالي



=IFERROR(IFERROR(" الأقامة تنتهي بعد "&DATEDIF(TODAY();$B$25;"y")&" سنة, "&DATEDIF(TODAY();$B$25;"ym")&" شهور و "&DATEDIF(TODAY();$B$25;"md")&" يوم ";" الإقامة أنتهــت منـذ "&DATEDIF($B$25;TODAY();"y")&" سنة, "&DATEDIF($B$25;TODAY();"ym")&" شهور و "&DATEDIF($B$25;TODAY();"md")&" يوم ");"")

تحويلها الي كود ان أمكن

وجزاك الله خيرا وبارك لك

رابط هذا التعليق
شارك

أخي عباد

جزاك الله كل خير واشكرك كثيرا علي التوضيح وعلي الكود الرائع وانك حقا مايسترو

تقبل تحياتي

وبارك الله لك في علمك وعملك ورزقك واولادك ونفعك بهم دنيا واخرة

رابط هذا التعليق
شارك

أرجو منك ارفاق مثال

وبه نتئاج المعادله للتأكد من نتائج الكود

واحاول أستبدلها بكود إن شاء الله

تحياتي

رابط هذا التعليق
شارك

أخي الكريم أبو نصار

لا اجد كلمات تكفي اعبر بها عن شكري لك عما تقدمه وعن رحابة صدرك

قمت بارفاق مثـال بالمعادلة

وجزاك الله خيرا

date.rar

رابط هذا التعليق
شارك

السلام عليكم

جرب هذا الكود

فرضاً عمود تاريخ الإنتهاء هو "A" يبدء من "A2"

عمود النتيجة "C"


Public Sub Ali_Ddif()

Dim m_r As Range, my_r As Range

Dim Dif_A%, I_a%, m_a%, N_a%, I%

With ActiveSheet

'*******************************************************

    Set my_r = .Range("A2") ' عمود تاريخ الإنتهاء

'*******************************************************

    Set m_r = .Range("C2") ' عمود النتيجة

'*******************************************************

    On Error Resume Next

    For I = 0 To .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row - 1

	    If IsDate(my_r.Offset(I, 0)) Then

		    Dif_A = my_r.Offset(I, 0) - Date

		    If Dif_A < 0 Then

		    '*******************************************************

			    I_a = Dif_Ali(Format(my_r.Offset(I, 0), "mm/dd/yyyy"), Format(Date, "mm/dd/yyyy"), "md")

			    m_a = Dif_Ali(Format(my_r.Offset(I, 0), "mm/dd/yyyy"), Format(Date, "mm/dd/yyyy"), "ym")

			    N_a = Dif_Ali(Format(my_r.Offset(I, 0), "mm/dd/yyyy"), Format(Date, "mm/dd/yyyy"), "y")

		    '*******************************************************

			    With m_r.Offset(I, 0)

				    .Font.Color = IIf(N_a >= 0 And m_a >= 0 And I_a >= 0, RGB(255, 0, 0), RGB(0, 176, 80))

				    .Value = " الإقامة أنتهــت منـذ " & N_a & " سنة , " & m_a & " شهور و " & I_a & " يوم ."

			    End With

		    Else

		    '*******************************************************

			    I_a = Dif_Ali(Format(Date, "mm/dd/yyyy"), Format(my_r.Offset(I, 0), "mm/dd/yyyy"), "md")

			    m_a = Dif_Ali(Format(Date, "mm/dd/yyyy"), Format(my_r.Offset(I, 0), "mm/dd/yyyy"), "ym")

			    N_a = Dif_Ali(Format(Date, "mm/dd/yyyy"), Format(my_r.Offset(I, 0), "mm/dd/yyyy"), "y")

		    '*******************************************************

			    With m_r.Offset(I, 0)

				    .Font.Color = IIf(N_a = 0 And m_a = 0 And I_a <= 0, RGB(255, 0, 0), RGB(0, 176, 80))

				    .Value = " الأقامة تنتهي بعد " & N_a & " سنة , " & m_a & " شهور و , " & I_a & " يوم . "

			    End With

		    End If

	    End If

    Next I

End With

End Sub

Private Function Dif_Ali(ByVal Fr_D As String, ByVal Sc_D As String, ByVal St_D As String) As Long

    Dif_Ali = Evaluate("DATEDIF(DATEVALUE(""" & Fr_D & """),DATEVALUE(""" & Sc_D & """),""" & St_D & """)")

End Function

أرجو التجربه وبلغنى بالنتائج

أفضل أن الطلب يكون في موضوع منفصل لسهولة البحث عنه وكي يستفيدو منه الأخوه الأعضاء

تحياتي

Datdif_A.rar

تم تعديل بواسطه عباد
رابط هذا التعليق
شارك

أخي الكريم ابو نصار

سلمك الله من كل والله أنت اكثر من رائع حقا انت رائع وكل اعمالك تشهد بذلك

وانا فعلا اتعلمت منها الكثير واشكرك علي رحابة صدرك

فضلا أرفق الكود مرة أخري

واناشد ادارة المنتدي.... بفصل الموضوع وجعله مشاركة منفصلة لتعم الفائدة علي الجميع واعتذر من ادارة المنتدي لعدم فتحي مشاركة جديدة من البداية

رابط هذا التعليق
شارك

اخى ابونصار

ما شاء الله لا قوة الا بالله

انت انسان مجتهد ومحب للعلم وللناس ايضا

جزاك الله خيرا

كود اكثر من رائع

سعد عابد

رابط هذا التعليق
شارك

أخي الكريم أبو نصـار أ. عباد

الكود أكثر من رائع مضبوط والحمد لله هـو المطلوب

سلمت من كل سوء

وجزاك الله خيرا عن علمك ونفعك به

وأشكرك علي سرعة استجابتك وسعة صدرك وتعبك معي وبارك الله فيك

تقبل تحياتي

رابط هذا التعليق
شارك

الحمد لله الذي بنعمته تتم الصالحات

لاتعب ولا شيء اخي ضاحي بالعكس هذا العمل لم أكن اعلمه

مع المحاولات والتجارب نصل لعدة أفكار

وما تعلمناه الفضل يعود لطلبات الأعضاء القيمه

تقبل تحياتي وشكري

رابط هذا التعليق
شارك

أخــي الكــريم الأستاذ/ عباد..... (ابو نصــار)

هنـاك مشكلة صغيرة ...... حيث أن عند القيام بتغيير التاريخ في الخلية (A2) - (لانه مربوط مع دالة البحث عن بيانات موظف ) لا تتغير نتيجة الكود في الخلية (C2)

شاهد المرفق

وأعتذر منك مرة اخري لكثرة طلباتي

,اشكرك جدا علي تعبك

تقبل تحياتي

date.rar

رابط هذا التعليق
شارك

اخي الكريم أ. عباد

هل من الممكن دمج كود دالة VLOOKUP التي ارفقته لي في المشاركة رقم (2) مع دالة الصلاحية بالمشاركة رقم (10)

بحيث ان خلية التاريخ عندي هي (B25) و ارجاع النتيجة في الخلية (B28 ) حتي تقوم الدالة بتحديث النتيجة مع بيانات الموظف في كود دالة VLOOKUP بالمشـاركة رقـم (2)

ولا ذلك غير صحيح من الناحية الفنية

تقبل تحياتي

رابط هذا التعليق
شارك

أخــي الكــريم الأستاذ/ عباد..... (ابو نصــار)

هنـاك مشكلة صغيرة ...... حيث أن عند القيام بتغيير التاريخ في الخلية (A2) - (لانه مربوط مع دالة البحث عن بيانات موظف ) لا تتغير نتيجة الكود في الخلية (C2)

شاهد المرفق

وأعتذر منك مرة اخري لكثرة طلباتي

,اشكرك جدا علي تعبك

تقبل تحياتي

الأخ الحبيب أبو نصار جزاكم الله خيراً على كل ما تقدمه

الأخ ضاحي جرب الملف التالي

Date.rar

رابط هذا التعليق
شارك

ارجو رافاق الملف الذي تعمل عليه

لاني لم اجد دالة VLOOKUP في اي خليه المعادله ؟

وخصوص دمج الكودين وضح الطلب في الملف

وإن شاء الله سيتم عمل ذلك

تحياتي

رابط هذا التعليق
شارك

أخواني العزاء

أخي الأستاذ ياسر خليل

أخي الأستاذ عبــاد

بـارك الله فيكم وجزاكم الله خير الجزاء في الدنيا والأخـرة

مرفق الملف بعد تجربة الأستاذ ياسر خليل ظبط لكن عند دمجه مع كود دالة Vlookup لم يعطي النتيجة

أخي عباد لقد ارفقت النموذج

وانا كلي خجل من طلباتي اليك

تقبل تحياتي

Data_Test1.rar

رابط هذا التعليق
شارك

السلام عليكم

استبدل كود حدث ورقة الطباعه بالتالي بعد التعديل


Private Sub Worksheet_Change(ByVal Target As Range)

'بواسطة ابو نصار أ. عبــاد

On Error Resume Next

Set MYRNG = Sheets("البيانات").[A1:AG1000]

If Not Intersect(Target, [B8]) Is Nothing Then

With Application

For I = 1 To 35

        c = Choose(I, 3, 4, 5, 6, 7, 8, 9, 11, 12, 13, 14, 16, 17, 18, 19)

        Cr = Choose(I, 2, 20, 27, 6, 4, 12, 7, 23, 24, 25, 26, 18, 33, 19, 22)

        If c = Null Or Cr = Null Then GoTo 0

        Cells(Target.Row + c, 2) = IIf(IsError(.VLookup(Target, MYRNG, Cr, 0)), "", .VLookup(Target, MYRNG, Cr, 0))

0 Next

.EnableEvents = False

'*************

  Ali_Ddif [B25], [B28]

'*************

.EnableEvents = True

End With

Set MYRNG = Nothing

End If

End Sub

Private Sub Ali_Ddif(ByVal Target As Range, R As Range)

Dim Dif_A%, I_a%, m_a%, N_a%, I%

'*******************************************************

        On Error Resume Next

                If IsDate(Target.Value) Then

                        Dif_A = Target - Date

                        If Dif_A < 0 Then

                        '*******************************************************

                                I_a = Dif_Ali(Format(Target, "mm/dd/yyyy"), Format(Date, "mm/dd/yyyy"), "md")

                                m_a = Dif_Ali(Format(Target, "mm/dd/yyyy"), Format(Date, "mm/dd/yyyy"), "ym")

                                N_a = Dif_Ali(Format(Target, "mm/dd/yyyy"), Format(Date, "mm/dd/yyyy"), "y")

                        '*******************************************************

                                With R

                                    .Font.Color = IIf(N_a >= 0 And m_a >= 0 And I_a >= 0, RGB(255, 0, 0), RGB(0, 176, 80))

                                    .Value = " الإقامة أنتهــت منـذ " & N_a & " سنة , " & m_a & " شهور و " & I_a & " يوم ."

                                End With

                        Else

                        '*******************************************************

                                I_a = Dif_Ali(Format(Date, "mm/dd/yyyy"), Format(Target, "mm/dd/yyyy"), "md")

                                m_a = Dif_Ali(Format(Date, "mm/dd/yyyy"), Format(Target, "mm/dd/yyyy"), "ym")

                                N_a = Dif_Ali(Format(Date, "mm/dd/yyyy"), Format(Target, "mm/dd/yyyy"), "y")

                        '*******************************************************

                                With R

                                    .Font.Color = IIf(N_a = 0 And m_a = 0 And I_a <= 0, RGB(255, 0, 0), RGB(0, 176, 80))

                                    .Value = " الأقامة تنتهي بعد " & N_a & " سنة , " & m_a & " شهور و , " & I_a & " يوم . "

                                End With

                        End If

                End If

End Sub

Private Function Dif_Ali(ByVal Fr_D As String, ByVal Sc_D As String, ByVal St_D As String) As Long

    Dif_Ali = Evaluate("DATEDIF(DATEVALUE(""" & Fr_D & """),DATEVALUE(""" & Sc_D & """),""" & St_D & """)")

End Function

أرجو التجربه

رابط هذا التعليق
شارك

بعد التجربة

استاذي أبو نصار

أكثر من رائع

حقا انك لمايسترو

تسلم وجزاك الله كل خير

وارجو تسامحني ان اثقلت عليك

بارك الله لك في كل شيء

وزادك علما ونفعا

وبظهر الغيب دعوة لكل اسرة منتدانا وصرحنا التعليمي أوفيسنا اللهم يجزيهم بما قدموا كل الخير واجعله في ميزان حسناتهم

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information