jo0 قام بنشر مايو 16, 2021 مشاركة قام بنشر مايو 16, 2021 السلام عليكم اريد دمج الكودين الاتيين Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub If Not Intersect(Target, Range("q9:q300")) Is Nothing Then If Target.Value = "a" Then Target.Offset(, -4).ClearContents End If If Not Intersect(Target, Range("r9:r300")) Is Nothing Then If Target.Value = "a" Then Target.Offset(, -6).ClearContents End If If Not Intersect(Target, Range("s9:s300")) Is Nothing Then If Target.Value = "a" Then Target.Offset(, -8).ClearContents End If If Not Intersect(Target, Range("t9:t300")) Is Nothing Then If Target.Value = "a" Then Target.Offset(, -10).ClearContents End If If Not Intersect(Target, Range("u9:u300")) Is Nothing Then If Target.Value = "a" Then Target.Offset(, -12).ClearContents End If If Not Intersect(Target, Range("v9:v300")) Is Nothing Then If Target.Value = "a" Then Target.Offset(, -14).ClearContents End If If Not Intersect(Target, Range("w9:w300")) Is Nothing Then If Target.Value = "a" Then Target.Offset(, -16).ClearContents End If If Not Intersect(Target, Range("x9:x300")) Is Nothing Then If Target.Value = "a" Then Target.Offset(, -18).ClearContents End If If Not Intersect(Target, Range("y9:y300")) Is Nothing Then If Target.Value = "a" Then Target.Offset(, -20).ClearContents End If End Sub مع الكود الثاني Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$g$3" And Target.Cells.Count = 1 Then Sheets("الحراسة").Range("$d$8") = Target End If Application.EnableEvents = True End Sub رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر مايو 16, 2021 أفضل إجابة مشاركة قام بنشر مايو 16, 2021 ربما هذا الكود Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim Large_RG As Range Dim Unique_RG As Range Dim Empty_String$, Other__String$ Dim Option_string$ Dim Position% Const m = 2 Empty_String = "": Other__String$ = "Hirassa" Set Large_RG = Range("Q9:Y300") Set Unique_RG = Range("G3") Dim q%, r%, S%, t%, u%, v%, W%, x%, y% q = 17: r = 18: S = 19: t = 20 u = 21: v = 22: W = 23: x = 24: y = 25 Application.EnableEvents = False If Not Intersect(Target, Unique_RG) Is Nothing _ And Target.Cells.Count = 1 Then Range("D8") = Other__String End If If Not Intersect(Target, Large_RG) Is Nothing _ And Target.Cells.Count = 1 Then Select Case Target.Column Case q: Option_string = Empty_String: Position = q - 2 * m Case r: Option_string = Empty_String: Position = r - 3 * m Case S: Option_string = Empty_String: Position = S - 4 * m Case t: Option_string = Empty_String: Position = t - 5 * m Case u: Option_string = Empty_String: Position = u - 6 * m Case v: Option_string = Empty_String: Position = v - 7 * m Case W: Option_string = Empty_String: Position = W - 8 * m Case x: Option_string = Empty_String: Position = x - 9 * m Case y: Option_string = Empty_String: Position = y - 10 * m End Select If Target = "a" Then Target.Offset(, Position) = Empty_String End If End If Application.EnableEvents = True End Sub الملف Joe_code.xlsm 1 رابط هذا التعليق شارك More sharing options...
jo0 قام بنشر مايو 16, 2021 الكاتب مشاركة قام بنشر مايو 16, 2021 شكرا ...لكن ليس هذا اريد فقط ان يعمل الكودين مع بعض فقط رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر مايو 16, 2021 مشاركة قام بنشر مايو 16, 2021 انهما يعملان مع بعض رابط هذا التعليق شارك More sharing options...
jo0 قام بنشر مايو 16, 2021 الكاتب مشاركة قام بنشر مايو 16, 2021 الكود الاول يقوم بحذف اذا نقرت نقر مزدوج والثاني يتعلق بقائمة منسدلة من ورقة اخرى اتحكم فيها من هذه الورقة رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر مايو 16, 2021 مشاركة قام بنشر مايو 16, 2021 الكودين من نوع Worksheet_Change(ByVal Target As Range) فأين الدويل كليك رابط هذا التعليق شارك More sharing options...
jo0 قام بنشر مايو 16, 2021 الكاتب مشاركة قام بنشر مايو 16, 2021 الكود الاول اذا نقرت نقر مزدوج في خلية يحذف خلية اخرى ..اما الثاني فيتعلق بالتحكم بقائمة منسدلة من ورقة اخرى رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر مايو 16, 2021 مشاركة قام بنشر مايو 16, 2021 لو كان الكود يعمل على الدوبل كليك لكان عنوانه Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) وليس Worksheet_Change(ByVal Target As Range) رابط هذا التعليق شارك More sharing options...
jo0 قام بنشر مايو 16, 2021 الكاتب مشاركة قام بنشر مايو 16, 2021 الكود الاول حذف محتوى خلية وفق شرط اما الثاني للقائمة المنسدلة رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان