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

**ضاحي الغريب** · ديسمبر 24, 2012

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

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

من فضلكم تعديل كود (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

**الـعيدروس** · ديسمبر 24, 2012

ألسلام عليكم

جرب هكذا


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

تم تعديل ديسمبر 24, 2012 بواسطه عباد

**ضاحي الغريب** · ديسمبر 24, 2012

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

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

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

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

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

تقبل تحياتي

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

**ضاحي الغريب** · ديسمبر 24, 2012

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

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



For i = 1 To 35

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

**الـعيدروس** · ديسمبر 24, 2012

السلام عليكم

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

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


For i = 1 To 35

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


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

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

تقبل تحياتي

**ضاحي الغريب** · ديسمبر 24, 2012

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

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

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

عندي معادلة في الخلية (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")&" يوم ");"")

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

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

**ضاحي الغريب** · ديسمبر 24, 2012

أخي عباد

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

تقبل تحياتي

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

**الـعيدروس** · ديسمبر 24, 2012

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

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

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

تحياتي

**ضاحي الغريب** · ديسمبر 24, 2012

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

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

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

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

date.rar

**الـعيدروس** · ديسمبر 24, 2012

السلام عليكم

جرب هذا الكود

فرضاً عمود تاريخ الإنتهاء هو "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

تم تعديل ديسمبر 24, 2012 بواسطه عباد

**ضاحي الغريب** · ديسمبر 24, 2012

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

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

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

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

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

**saad abed** · ديسمبر 24, 2012

اخى ابونصار

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

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

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

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

سعد عابد

**الـعيدروس** · ديسمبر 24, 2012

اخي الحبيب سعد عابد

مرورك اسعدني

واشكرك على كلماتك الطيبه

بارك الله فيك

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

**ضاحي الغريب** · ديسمبر 24, 2012

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

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

سلمت من كل سوء

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

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

تقبل تحياتي

**الـعيدروس** · ديسمبر 24, 2012

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

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

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

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

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

**ضاحي الغريب** · ديسمبر 24, 2012

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

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

شاهد المرفق

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

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

تقبل تحياتي

date.rar

**ضاحي الغريب** · ديسمبر 24, 2012

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

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

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

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

تقبل تحياتي

ياسر خليل أبو البراء · ديسمبر 24, 2012

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

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

شاهد المرفق

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

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

تقبل تحياتي

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

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

Date.rar

**الـعيدروس** · ديسمبر 24, 2012

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

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

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

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

تحياتي

**ضاحي الغريب** · ديسمبر 24, 2012

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

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

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

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

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

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

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

تقبل تحياتي

Data_Test1.rar

**الـعيدروس** · ديسمبر 24, 2012

السلام عليكم

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


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

أرجو التجربه

**ضاحي الغريب** · ديسمبر 24, 2012

بعد التجربة

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

أكثر من رائع

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

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

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

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

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

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

تسجيل الدخول

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

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

ضاحي الغريب

الـعيدروس

ضاحي الغريب

ضاحي الغريب

الـعيدروس

ضاحي الغريب

ضاحي الغريب

الـعيدروس

ضاحي الغريب

الـعيدروس

ضاحي الغريب

saad abed

الـعيدروس

ضاحي الغريب

الـعيدروس

ضاحي الغريب

ضاحي الغريب

ياسر خليل أبو البراء

الـعيدروس

ضاحي الغريب

الـعيدروس

ضاحي الغريب

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information