مساعدة في كود 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

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

[ضاحي الغريب]

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

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

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

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

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

تقبل تحياتي

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

[ضاحي الغريب]

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

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

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

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

[ضاحي الغريب]

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

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

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

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

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

[saad abed]

اخى ابونصار

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

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

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

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

سعد عابد

[الـعيدروس]

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

مرورك اسعدني

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

بارك الله فيك

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

[ضاحي الغريب]

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

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

سلمت من كل سوء

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

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

تقبل تحياتي

[الـعيدروس]

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

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

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

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

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

[ضاحي الغريب]

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

هنـاك مشكلة صغيرة ...... حيث أن عند القيام بتغيير التاريخ في الخلية (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

أرجو التجربه

[ضاحي الغريب]

بعد التجربة

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

أكثر من رائع

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

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

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

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

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

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