سليم حاصبيا

يمكنك استعمال هذا الماكرو للتبديل Sub My_Borders1() If Range("A1:D10").Borders.LineStyle = -4142 Then Range("A1:D10").Borders.LineStyle = 1 Else Range("A1:D10").Borders.LineStyle = -4142 End If End Sub

استبدل الرقم 1 بالرقم 0

جرب المرفق ex1 salim.rar

هذا الماكرو البسيط Sub My_Borders() Range("A1:D10").Borders.LineStyle = 1 End Sub

الاسماء تارة ثلاثية وطوراً رباعية (يصعب العمل مع هذه البيانات)

ربما يساعدك هذا الملف Date_If.rar

تفضل هذا المثال تراجع salim1.rar

حسب ما رأيت في اليوزر ان كل التكست بوكسات متعلقة بالتكست بوكس 1 لذلك اي تعديل عليه ينعكس على الباقين تستطيع ان تحدد متغير لكل تكست بوكس باسم معين كما انا فعلت بالتكست بوكس 1 عبر تعيين Oldval

ربما كان المطلوب تراجع salim.rar

هذا الماكرو يقوم بما تريد Sub advanced_Salim() Dim My_rg As Range Dim My_Sht_Source As Worksheet Dim My_Sht_Target As Worksheet Dim Lr, Lra As Long, x As Integer Set My_Sht_Source = Sheets("كل الاشهر") Set My_Sht_Target = Sheets("السيارات الخاصة") My_Sht_Target.Cells.Clear Lr = My_Sht_Source.Cells(Rows.Count, 1).End(3).Row Set My_rg = My_Sht_Source.Range("A1:H" & Lr) x = Application.CountA(My_Sht_Source.Range("j8:j500")) + 7 Lra = My_Sht_Target.Cells(Rows.Count, 1).End(3).Row If Lra = 1 Then Lra = 2 For k = 8 To x My_Sht_Source.Range("xfd2").Formula = "=E2=$J$" & k '============================== My_rg.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("كل الاشهر").Range("xfd1:xfd2"), CopyToRange:=My_Sht_Target.Range("A" & Lra) Lra = My_Sht_Target.Cells(Rows.Count, 1).End(3).Row + 2 Next End Sub

انسخ هذه المعادلة الى الخلية A2 من الورقة السيارات الخاصة واسحبها يميناً حتى العامود H ثم الى اسفل قدر ما تريد من الصفوف =IF('كل الاشهر'!$J8="","",INDEX('كل الاشهر'!A$2:A$4364,MATCH('كل الاشهر'!$J8,'كل الاشهر'!$E$2:$E$4364,0)))

جرب مبدئباً هذا الماكرو Sub filter_for_me() Dim My_rg As Range Dim my_sht As Worksheet Dim lr As Long Dim ws9, ws10, ws11, ws12, ws1, ws2, ws3, ws4 As Worksheet Set my_sht = Sheets("كل الاشهر") Set ws9 = Sheets("شهر9-2016"): Set ws10 = Sheets("شهر10-2016") Set ws11 = Sheets("شهر11-2016"): Set ws12 = Sheets("شهر12-2016") Set ws1 = Sheets("شهر1-2017"): Set ws2 = Sheets("شهر2-2017") Set ws3 = Sheets("شهر3-2017"): Set ws4 = Sheets("شهر4-2017") Application.ScreenUpdating = False lr = my_sht.Cells(Rows.Count, 1).End(3).Row Set My_rg = my_sht.Range("A1:H" & lr) '=================================== My_rg.AutoFilter Field:=4, Operator:=xlFilterValues, Criteria2:=Array(1, "9/30/2016") My_rg.SpecialCells(xlCellTypeVisible).Copy ws9.Range("A1").PasteSpecial Paste:=xlPasteAll my_sht.Range("A1:H" & lr).AutoFilter My_rg.AutoFilter ''''''''''''''''''''''''''''' '=================================== My_rg.AutoFilter Field:=4, Operator:=xlFilterValues, Criteria2:=Array(1, "10/31/2016") My_rg.SpecialCells(xlCellTypeVisible).Copy ws10.Range("A1").PasteSpecial Paste:=xlPasteAll My_rg.AutoFilter '=================================== My_rg.AutoFilter Field:=4, Operator:=xlFilterValues, Criteria2:=Array(1, "11/30/2016") My_rg.SpecialCells(xlCellTypeVisible).Copy ws11.Range("A1").PasteSpecial Paste:=xlPasteAll My_rg.AutoFilter '=================================== My_rg.AutoFilter Field:=4, Operator:=xlFilterValues, Criteria2:=Array(1, "12/31/2016") My_rg.SpecialCells(xlCellTypeVisible).Copy ws12.Range("A1").PasteSpecial Paste:=xlPasteAll My_rg.AutoFilter '=================================== My_rg.AutoFilter Field:=4, Operator:=xlFilterValues, Criteria2:=Array(1, "1/31/2017") My_rg.SpecialCells(xlCellTypeVisible).Copy ws1.Range("A1").PasteSpecial Paste:=xlPasteAll My_rg.AutoFilter '=================================== My_rg.AutoFilter Field:=4, Operator:=xlFilterValues, Criteria2:=Array(1, "2/28/2016") My_rg.SpecialCells(xlCellTypeVisible).Copy ws2.Range("A1").PasteSpecial Paste:=xlPasteAll My_rg.AutoFilter '=================================== My_rg.AutoFilter Field:=4, Operator:=xlFilterValues, Criteria2:=Array(1, "3/31/2016") My_rg.SpecialCells(xlCellTypeVisible).Copy ws3.Range("A1").PasteSpecial Paste:=xlPasteAll My_rg.AutoFilter '=================================== My_rg.AutoFilter Field:=4, Operator:=xlFilterValues, Criteria2:=Array(1, "4/30/2016") My_rg.SpecialCells(xlCellTypeVisible).Copy ws4.Range("A1").PasteSpecial Paste:=xlPasteAll My_rg.AutoFilter Application.ScreenUpdating = True End Sub

=INDEX($C$2:$C$22,MATCH(TRUE,$L$3&$G5=$A$2:$A$22&$B$2:$B$22,0))+INDEX($C$2:$C$22,MATCH(TRUE,$L$4&$G5=$A$2:$A$22&$B$2:$B$22,0))+INDEX($C$2:$C$22,MATCH(TRUE,$L$5&$G5=$A$2:$A$22&$B$2:$B$22,0)) جرب هذه المعادلة في الخلية H5 واسحب نزولاُ المعادلة يلزمها (Ctr+Shift+enter) و ليس Enter وحدها

جرب المرفق Sh. 2017salim.rar

جرب هذا الماكرو Sub Transfere_Data() Dim Ws1, Ws2 As Worksheet Set Ws1 = Sheets("File 1"): Set Ws2 = Sheets("File2") Application.ScreenUpdating = False Ws2.Range("a1").CurrentRegion.Clear Ws1.Range("a1").CurrentRegion.Copy With Ws2.Range("a1").CurrentRegion .PasteSpecial xlPasteAll: .Value = .Value End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

جرب هذا الماكرو المرفق فيه كل التفاصيل تم ازالة الخلابا المدمجة من الاوراق لانها تعيق عمل الماكرو Sub Transfere_Data() lr = Sheets("Master").Range("A2").End(xlDown).Row If lr < 2 Then Exit Sub k = 2 For i = 1 To Sheets.Count - 1 If k > lr + 1 Then Exit Sub With Sheets(i + 1) Set my_rg = Sheets("Master").Range("a" & k & ":j" & k) .Range("d5") = my_rg.Cells(1) .Range("d6") = my_rg.Cells(2) .Range("g6") = my_rg.Cells(3) .Range("d8") = my_rg.Cells(4) .Range("d9") = my_rg.Cells(5) .Range("g9") = my_rg.Cells(6) .Range("d11") = my_rg.Cells(7) .Range("g12") = my_rg.Cells(8) .Range("d14") = my_rg.Cells(9) .Range("g14") = my_rg.Cells(10) k = k + 1 End With Next End Sub KPIs-Docs Salim.rar

ربما ينفع هذا الكود Sub My_date2() Range("A6") = #3/25/2017# Range("A6").NumberFormat = "[$-1170000]B2dd/mm/yyyy;@" End Sub

ليس لدي الخبرة الكافية للتاريخ الهجري

للتاريخ اضافة خاصة في الكود يجب استعمال الاشارة # في الكود يجب كتابة الشهر اولاً ثم اليوم وثم السنة و فيما بعد تطلب من الكود التنسيق Sub My_date() Range("b2") = #2/15/2010# Range("b2").NumberFormat = "dd/mm/yyyy" End Sub يمكن الاستغناء عن السطر الثالث في الكود اذا كان التنسيق في الخلية معرف مسبقاً

vlookup لا تعمل غي مثل عذه الحالة يجب استعمال هذه المعادلة في الخلية a2 من الصفحة simple =INDEX(Accounts!$A$2:$A$250,MATCH(Sample!B2,Accounts!$C$2:$C$250,0)) وكذلك الامر بالنسبة لبقية الخلايا

هذا كود جديد مختلف ( مستقل عن العمود A) Sub Salim1() my_max = 0 For i = 4 To 11 lr = Sheets("Feuil1").Cells(Rows.Count, i).End(3).Row If lr >= my_max And lr > 2 Then my_max = lr Next If my_max = 0 Then Exit Sub For m = 3 To my_max Cells(m, "L").Formula = "=COUNTA(D" & m & ":K" & m & ")" Cells(m, "L").Value = Cells(m, "L").Value Next End Sub

هذا الكود يوضع في حدث الصفحة (حدد الصفحة المطلوب العمل فيها من VBa editor بواسطة دوبل كليك) ثم انسخ الكود كي يعمل الكود يجب ان يكون عامود A مرقماً بشكل صحيح Private Sub Worksheet_Change(ByVal Target As Range) Dim lr As Integer Application.EnableEvents = False lr = Application.Max(Range("a:a")) + 2 If Not Intersect(Target, Range("D3:k" & lr)) Is Nothing And Target.Count = 1 Then Cells(Target.Row, "l") = Evaluate("COUNTA(D" & Target.Row & ":k" & Target.Row & ")") End If Application.EnableEvents = True End Sub

جرب هذا الكود Sub Salim() For i = 3 To 10 Cells(i, "l") = Evaluate("COUNTA(D" & i & ":k" & i & ")") Next End Sub

بعد اذت اخي زيزو ربما ينال اعجابك هذا الملف ترتيب ابجدي Salim.rar

جرب هذا المعادلة في الخلية B2واسحب نزولاً =IF(A1="","",REPLACE(A1,FIND(CHAR(32),A1)+1,1,""))