البحث في الموقع

السلام عليكم ورحمة الله وبركاته لدى كود جيد ويؤدى وظيفتة بدقه وهو يتعامل مع ثلاث أوراق طلبى هو زيادة سرعته فهو يأخذ حوالى 7 ثوانى فى تنفيذ مهامه شكراً لكم وبالتوفق 'كود جلب بيانات Private Sub Worksheet_Change(ByVal Target As Range) If Cells(4, 2).Value = "ON" Then ' لإيقاف وتشغيل الكود Dim ws As Worksheet, tbl As Long, tmp As Long, i As Long Dim n As String, Max As Long, ky As Boolean Max = 461 If Not Intersect(Target, Range("D2,D4,B4,B7")) Is Nothing Then Set ws = Sheets("حساب الفوائد") Set SA = Sheets("مؤشر الفائدة") Set SB = Sheets("P") '------------------------------------------------------------------------------------------ 'استخراج البيانات المطلوبة من بيانات الشهادات 'On Error Resume Next Application.ScreenUpdating = False Application.Calculation = xlCalculationAutomatic SA.Range("BH2") = 2 'مسح البيانات من منطقة منطقة عرض البيانات SA.Range("D6:BC207").ClearContents ws.Range("DN26:FA225").ClearContents ws.Range("FG26:HF225").ClearContents '-------------------------------------------------------------------------------------------------- 'فك البيانات Application.ScreenUpdating = False Dim sp As Variant, j&, lr& With Application .ScreenUpdating = False: .Calculation = xlCalculationManual .ErrorCheckingOptions.BackgroundChecking = True End With lr = ws.Cells(ws.Rows.Count, "DK").End(xlUp).Row For j = 26 To lr sp = Split(ws.Cells(j, "DK").Value2, "*") For i = LBound(sp) To UBound(sp) ws.Cells(j, i + 118).NumberFormat = "@" ws.Cells(j, i + 118).Value = sp(i) Next i Next j With Application .ScreenUpdating = True: .Calculation = xlCalculationAutomatic .ErrorCheckingOptions.BackgroundChecking = False End With '------------------------------------------------------------------------------------------- 'نسخ البيانات المفككة إلى إلى ورقة عرض البيانات Application.ScreenUpdating = False ws.Range("DN26:FA225").SpecialCells(xlCellTypeVisible).COPY ws.Range("FL26:GY225").PasteSpecial xlPasteValues '--------------------------------------------------------------------------------------------- 'معادلة لضرب عدد الأشهر فى قيمة الفائدة الشهرية If SA.Range("BJ4") = 33 Then ws.Range("FL26:GY26") = ws.Range("FL25:GY25").Formula ws.Range("FL26:GY26").AutoFill Destination:=ws.Range("FL26:GY225"), Type:=xlFillDefault End If '----------------------------------------------------------------------------------------------- Application.ScreenUpdating = False 'معادلات لتكون صفحة العرض بلا معادلات If SA.Range("BJ4") = 33 Or SA.Range("BJ4") <> 33 Then ws.Range("FG26:FK225") = ws.Range("FG25:FK25").Formula ws.Range("FG26:FK225") = ws.Range("FG26:FK225").Value ws.Range("GZ26:HF225") = ws.Range("GZ24:HF24").Formula ws.Range("GZ26:HF225") = ws.Range("GZ26:HF225").Value SA.Range("D7:H7") = ws.Range("FG24:FK24").Value SA.Range("F4:H6") = ws.Range("FI21:FK23").Value SA.Range("AW6:BC7") = ws.Range("GZ22:HF23").Value End If ' ----------------------------------------------------------------------------------------------- ws.Range("FL24:GY24").SpecialCells(xlCellTypeVisible).COPY SA.Range("I7:AV7").PasteSpecial xlPasteValues ws.Range("FG26:HF225").SpecialCells(xlCellTypeVisible).COPY SA.Range("D8:BC207").PasteSpecial xlPasteValues ' ----------------------------------------------------------------------------------------------- Application.ScreenUpdating = False SB.Range("D8:L208").ClearContents SA.Range("D6:H207").SpecialCells(xlCellTypeVisible).COPY SB.Range("D7:H208").PasteSpecial xlPasteValues SA.Range("F4:H6").SpecialCells(xlCellTypeVisible).COPY SB.Range("F5:H7").PasteSpecial xlPasteValues ws.Range("HI25:HL225").SpecialCells(xlCellTypeVisible).COPY SB.Range("I8:L208").PasteSpecial xlPasteValues SA.Range("J5") = SA.Range("BQ5").Value ' ----------------------------------------------------------------------------------------------- 'لإخفاء الأعمده الفارغة Application.ScreenUpdating = False For s = 9 To 54 If Cells(7, s).Value = "" Then Columns(s).EntireColumn.Hidden = True Else Columns(s).EntireColumn.Hidden = False End If Next s 'إحتواء منسب الأعمده For s = 9 To 54 If Cells(7, s).Value <> "" Then Columns(s).AutoFit End If Next s '------------------------------------------------------------------------------------------ 'لتغير الخطوط Application.ScreenUpdating = False If Sheets("مؤشر الفائدة").Range("B7") = 1 Then Sheets("مؤشر الفائدة").Range("AY8:AY207, BB8:BB208,BR2:BR4").Select With Selection.Font .Name = "Wingdings 3" .Size = 14 Selection.HorizontalAlignment = xlCenter End With End If If Sheets("مؤشر الفائدة").Range("B7") = 2 Then Sheets("مؤشر الفائدة").Range("AY8:AY207, BB8:BB208,BR2:BR4").Select With Selection.Font .Name = "Arial" .Size = 16 Selection.Font.Bold = True Selection.HorizontalAlignment = xlCenter End With End If If Sheets("مؤشر الفائدة").Range("B7") = 3 Then Sheets("مؤشر الفائدة").Range("AY8:AY207, BB8:BB208,BR2:BR4").Select With Selection.Font .Name = "Arial" .Size = 16 Selection.HorizontalAlignment = xlCenter End With End If Application.ScreenUpdating = False '----------------------------------------------------------------------------------------- ' لتلوين برواز الخلية ALP Application.ScreenUpdating = False If SA.Range("BJ6") = 5 Then SA.Range("AZ6").Select With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Color = -10839132 End With With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Color = 0 End With End If If SA.Range("BJ6") <> 5 Then SA.Range("AZ6").Select With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Color = 0 With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Color = -10839132 End With End With End If ' ------------------------------------------------------------------------------------------------ 'P للتنسيق فى ورقة Sheets("P").Select Application.ScreenUpdating = False If Sheets("P").Range("I8") = "إجمــاليــات" Then Sheets("P").Range("$I$9:$J$208").Select With Selection.Font Selection.HorizontalAlignment = xlRight Selection.NumberFormat = "#,##0.00" Sheets("P").Range("$I$7:$J$208").Select Selection.Columns.AutoFit Sheets("P").Range("$K$8").Select Selection.Columns.Hidden = False End With Sheets("P").Range("D8").Select End If If Sheets("P").Range("I8") = "عدد" Then Sheets("P").Range("$I$9:$J$208").Select With Selection.Font Selection.HorizontalAlignment = xlCenter Selection.NumberFormat = "General" Sheets("P").Range("$I$8:$K$208").Select Selection.Columns.AutoFit Sheets("P").Range("$K$8").Select Selection.Columns.Hidden = True End With Sheets("P").Range("D8").Select End If Sheets("مؤشر الفائدة").Select Application.ScreenUpdating = Fals ActiveSheet.Shapes.Range(Array("مستطيل 10")).Select Application.ScreenUpdating = False If Selection.Text = "إخفاء الأعمدة" Then With Selection Selection.Text = "إظهار الأعمدة" .Font.Color = -4072739 .ShapeRange.Fill.ForeColor.RGB = _ RGB(15, 15, 15) .ShapeRange.Line.ForeColor.RGB = _ RGB(169, 158, 103) End With End If End If Sheets("مؤشر الفائدة").Range("I7").Select End If End Sub