أبو قاسم قام بنشر يونيو 25, 2015 مشاركة قام بنشر يونيو 25, 2015 Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim R As Integer If Not Intersect(Target.Cells(1, 1), Union(Range("B2:B10000"), Range("o2:o10000"))) Is Nothing Then R = Target.Row If Cells(R, "B").Value <> "" Then Cells(R, "A").Value = R + 4999 Cells(R, "C").Value = WorksheetFunction.VLookup(Cells(R, "B"), [TUNNEL3], 2, 0) Cells(R, "D").Value = WorksheetFunction.VLookup(Cells(R, "B"), [TUNNEL3], 3, 0) Else Union(Cells(R, "0"), Cells(R, "0")).ClearContents End If End If If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Row > 1 And Target.Column = 8 Then With Target.Offset(, 1) .Formula = "=MOD(" & (Target - Target.Offset(, -1)) & ",1)": .Value = .Value End With End If If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Row > 1 And Target.Column = 11 Then With Target.Offset(, 1) .Formula = "=MOD(" & (Target - Target.Offset(, -4)) & ",1)": .Value = .Value End With End If If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("B:B")) Is Nothing Then With Target(1, 3) .Value = Date End With End If On Error GoTo 0 End Sub رابط هذا التعليق شارك More sharing options...
أبو قاسم قام بنشر يونيو 26, 2015 الكاتب مشاركة قام بنشر يونيو 26, 2015 للرفع رابط هذا التعليق شارك More sharing options...
أفضل إجابة خالد الشاعر قام بنشر يونيو 26, 2015 أفضل إجابة مشاركة قام بنشر يونيو 26, 2015 استاذ صلاح يوضع هذا الامر فى بداية الكود Application.ScreenUpdating = False و فى النهاية Application.ScreenUpdating = True 1 رابط هذا التعليق شارك More sharing options...
أبو قاسم قام بنشر يونيو 26, 2015 الكاتب مشاركة قام بنشر يونيو 26, 2015 تشكر الف الف شكر ماقصرت رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.