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

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

قام بنشر

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

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

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

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

  • الردود 51
  • Created
  • اخر رد

Top Posters In This Topic

قام بنشر (معدل)

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

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

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

If Target.Address = [D9].Address Then

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

تم تعديل بواسطه إبراهيم ابوليله
قام بنشر

الاخ رجب

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

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

فكيف يكون ذلك

الكود الاول

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

قام بنشر

تفضل أخى

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


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

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان



×
×
  • اضف...

Important Information