اريد كود او معادله لادخال البيانات فى العمود الاول حسب شروط معينة ( عنوان معدل )

[إبراهيم ابوليله]

الاخوه الكرام

هذا الكود يعمل على العمود الاول

وانا اريده ان يعمل على العمود الرابع بدلا من العمود الاول

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 1 And Target.Row > 9 Then

On Error GoTo 10

If Target = "" Then Exit Sub

If Len(Target) < 12 Then GoTo 10

If Len(Target) > 14 Then GoTo 10

If Asc(Mid(Target, 1, 1)) < 65 Then GoTo 10

If Asc(Mid(Target, 1, 1)) > 192 Then GoTo 10

If Asc(Mid(Target, 2, 1)) < 65 Then GoTo 10

If Asc(Mid(Target, 2, 1)) > 192 Then GoTo 10

If Asc(Mid(Target, 3, 1)) < 65 Then GoTo 10

If Asc(Mid(Target, 3, 1)) > 192 Then GoTo 10

If Mid(Target, 4, 7) * 1 > 0 Then GoTo 10

If Mid(Target, 11, 1) <> "/" Then GoTo 10

If Mid(Target, 12, 3) * 1 < 1 Then GoTo 10

GoTo 20

10

Target = ""

MsgBox "إدخال غير صحيح"

20

End If

End Subقناع ادخال2(1).rar

[إبراهيم ابوليله]

للرفع

[الخالدي]

في السطر

If Target.Column = 1 And Target.Row > 9 Then

استبدل الرقم 1 بالرقم 4 يصبح السطر بعد التعديل

If Target.Column = 4 And Target.Row > 9 Then

[إبراهيم ابوليله]

الاخ الخالدى

بارك الله فيك

ولكن ماذا لو اردنا قصر الادخال على الخليه D9 فقط

[إبراهيم ابوليله]

للرفع

[إبراهيم ابوليله]

للرفع

[رجب جاويش]

تفضل أخى

استبدل السطر التالى

If Target.Column = 1 And Target.Row > 9 Then

بالسطر

If Target.Address = [D9].Address Then

[إبراهيم ابوليله]

الاخ رجب بارك الله فيك

ولكن ما تصورك لو اردت تطبيقها فى الحالتين

If Target.Column = 1 And Target.Row > 9 Then

If Target.Address = [D9].Address Then

فكيف يكون شكل الكود

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

[رجب جاويش]

أخى الفاضل

يكون السطر كالاتى

If (Target.Column = 1 And Target.Row > 9) Or Target.Address = [D9].Address Then

[إبراهيم ابوليله]

الاخ رجب

بارك الله لك

وجعل مشاركاتك فى هذا المندتدى فى ميزان حسناتك

[إبراهيم ابوليله]

الاخوه الكرام

هذا كود للاخ رجب

اريد بعض التعديل عليه

ارجو الافاده

[إبراهيم ابوليله]

الاخوه الكرام

هذا كود للاخ رجب

اريد بعض التعديل عليه

ارجو الافاده

3.rar

[إبراهيم ابوليله]

للرفع

[رجب جاويش]

هل تقصد هكذا

3.rar

[إبراهيم ابوليله]

الاخ رجب

والله يعجز اللسان عن ايجاد الكلمات التى تستحقها

بارك الله فيك

كود رائع

ولكن اطمع فى شرح وافى للكود

[إبراهيم ابوليله]

الاخ رجب

اسف على الاطاله ولكن قد تفضلت سابقا بعمل كود اخر

وانا ايد اضافته مع هذا الكود ليصبح كود واحد

فكيف يكون ذلك

الكود الاول

Private Sub Worksheet_Selectionchange(ByVal Target As Range)

Dim cl As Range

For I = 9 To [A10000].End(xlUp).Row

Cells(I, 3) = Mid(Cells(I, 1), InStr(Cells(I, 1), "/") + 1)

Next

End Sub

والكود الثانى

Private Sub Worksheet_Selectionchange(ByVal Target As Range)

Dim cl As Range

For i = 10 To [A10000].End(xlUp).Row

y = Mid(Cells(i, 1), InStr(Cells(i, 1), "/") + 1) & "/" & _

Mid(Cells(i, 1), InStr(Cells(i, 1), "/") - 4, 2)

Cells(i, 5) = y

Next

End Sub

[رجب جاويش]

أرجو التوضيح أكثر

وما الغرض من دمج الكودين معا

[إبراهيم ابوليله]

الاخ رجب

انا لا اريد ان ادمج الكودين

ولكن كل مار اريد هو استخراج البيانات

التى يقوم بها كل كود على حده

ولا اعرف كيفيه التنفيذ

لاحظ المرفق3.rar

[رجب جاويش]

تفضل أخى

تم اختصار الكودين فى كود واحد لتنفيذ المهمتين

Private Sub Worksheet_Selectionchange(ByVal Target As Range)

For i = 11 To [A10000].End(xlUp).Row

y = Mid(Cells(i, 1), InStr(Cells(i, 1), "/") + 1) & "/" & _

Mid(Cells(i, 1), InStr(Cells(i, 1), "/") - 2, 2)

Cells(i, 2) = y

Cells(i, 3) = Mid(Cells(i, 1), InStr(Cells(i, 1), "/") + 1)

Next

End Sub

3.rar

[إبراهيم ابوليله]

الاخ رجب

فعلا هذا ما اريد

ولقد عرفت ماكنت اخطأ فيه

ولكن مازلت انتظر من شرح وافيا للكود

بارك الله لك وفيك

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

اللهم اميين

[إبراهيم ابوليله]

الاخ رجب

عزرا على الاطاله فى هذا الموضوع

ولكنى حينما اردت التغير فى رقم الصف

ليصبح رقم 9 بدلا من رقم 11حدث خطأ

ارجو الافادهCopy of 3.rar

For i = 9 To [A10000].End(xlUp).Row

[رجب جاويش]

جرب هذا التعديل

Private Sub Worksheet_Selectionchange(ByVal Target As Range)

For i = 9 To [A10000].End(xlUp).Row

If Cells(i, 1) <> "" Then

y = Mid(Cells(i, 1), InStr(Cells(i, 1), "/") + 1) & "/" & _

Mid(Cells(i, 1), InStr(Cells(i, 1), "/") - 2, 2)

Cells(i, 2) = y

Cells(i, 3) = Mid(Cells(i, 1), InStr(Cells(i, 1), "/") + 1)

End If

Next

End Sub

[إبراهيم ابوليله]

الاخ رجب

مشكورا على الكود الجميل

وبارك الله فيك

[إبراهيم ابوليله]

اخى الكريم رجب

مازلت منتظرا شرح الكود

بارك الله فيك

[إبراهيم ابوليله]

للرفع