سليم حاصبيا

هذه المعادلة =CHOOSE((H9="ALL")+1,SUMIFS(D:D,A:A,H9,C:C,I9),SUMIFS(D:D,C:C,I9)) MY_Classeur.xlsx

اولا ما هو برأيك الشيت الاساسي (اسمه) ثانياً اين (في اي عامود) توجد هذه الكلمات

تم تغيير اسم الورقة الاولى الى "DATA_BASE" لحسن التعامل مع المعادلات باللغة الاحنبية المعادلة المطلوبة في الخلية G2 يلزمها (Ctrl+Shift+Enter) وليس (Enter) وحدها لانها معادلة صفيف =IF(A2="","",INDEX(DATA_BASE!$C$2:$C$50,SMALL(IF(DATA_BASE!$C$2:$C$50<>"",IF(DATA_BASE!$A$2:$A$50=$A2,ROW($C$2:$C$50)-ROW($C$2)+1)),COUNTIF(DATA_BASE!$A$2:A2,A2)))) الملف مرفق للمعاينة SALIM_VLOOKUP.xlsx

استبدل السطر حيث يوجد خطأ في الكود بهذه الــ 3 سطور If st <> vbNullString Then F.Cells(k, "AG") = Mid(st, 1, Len(st) - 1) End If

ماكرو اخر يقوم بنفس العمل Option Explicit Sub Join_by_three_by_Loops() Dim my_rg As Range Dim lr%, i%, col%, m%, k% col = Cells(1, Columns.Count).End(1).Column lr = Range("A2", Range("A1")).End(4).Row m = lr + 2 Range("A" & m).CurrentRegion.Clear i = 1 Do Until i > lr k = 0 Do While k < 3 Range("A" & i + k).Resize(, col).Copy _ Range("A" & m).Offset(, k * col) k = k + 1 Loop m = m + 1 i = i + 3 Loop End Sub

جرب هذا الماكرو Option Explicit Sub Join_by_three() Dim my_rg As Range Dim lr%, i%, col%, m%, k% col = Cells(1, Columns.Count).End(1).Column lr = Range("a2", Range("A1")).End(4).Row m = lr + 2 Range("a" & m).Resize(10000, 3 * col).Clear For i = 1 To lr Step 3 For k = 0 To 2 Range("a" & i + k).Resize(, col).Copy _ Range("a" & m).Offset(, k * col) Next k m = m + 1 Next i End Sub MY_one_file.xlsm

جرب هذا الكود Option Explicit Sub find_min() Dim F As Worksheet, i%, k% Dim lr, arr(1 To 8) Dim m%: m = 1 Dim st$ Set F = Sheets("Feuil2") lr = F.Cells(Rows.Count, "i").End(3).Row If lr < 9 Then Exit Sub F.Cells(9, "AG").Resize(lr).ClearContents For i = 9 To 30 Step 3 arr(m) = i m = m + 1 Next For k = 9 To lr For i = 1 To UBound(arr) If F.Cells(k, arr(i)) = F.Cells(k, "AF") Then st = st & F.Cells(2, arr(i) - 1) & ";" End If Next F.Cells(k, "AG") = Mid(st, 1, Len(st) - 1) st = vbNullString Next Erase arr: Set F = Nothing End Sub الملف مرفق مع زر لنتفذ الكود find_min.xlsm

جرب هذاه المعادلة =INDEX($B$3:$B$8,MOD(ROWS($A$1:A1),2)+1,)*1

اذا كنت قد فهمت عليك ماذا تريد اليك هذا الحل For_Dev.xlsx

ربما هذا الكود يفي بالغرض Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Column = 1 And Target.Count = 1 And _ Application.CountIf(Range("salim_rg"), Target) <> 0 And Target.Offset(1) = "Total" Then ADD_rows (Target.Row) With Target.Offset(2, 1) .Formula = "=sum(B3:B" & Target.Row & ")" .Offset(, 1).Formula = "=sum(C3:C" & Target.Row & ")" .Offset(, 2).Formula = "=sum(D3:D" & Target.Row & ")" End With End If Application.EnableEvents = True End Sub '+++++++++++++++++++++++++++++++++++++++++ Sub ADD_rows(n%) Dim MyRows As Integer MyRows = Range("A3").CurrentRegion.Rows.Count + 2 Rows(n + 1).Insert Shift:=xlDown Cells(n, 1).Offset(, 1).Resize(, 3).Formula = _ "=VLOOKUP($A" & n & ",salim_rg,COLUMNS($A$1:A1)+1,0)" End Sub الملف للمعاينة مرفق Auto_Load.xlsm

تفضل الحل في الصورة لا يمكن العمل لانه لا مجال لرؤية اعمدة الخلايا ولا صفوفها (من اين اعرف اني اتعامل مع الخلية D2 واستنتاج المطلوب من الخلية F2 مثلاُ) و بالتالي كيف تكتب معادلة Exemple.xlsx

صديقي.. لا يمكن العمل على صورة و ليس لي اي علم ان صورة تستطيع ان تعالج معادلة من اكسل ريثما تستطيع MicroSoft ان تجعل الصورة تفعل هذا الشي عليك رفع الملف وليس صورة عنه

Try this File My_sarch.xlsm

أولاً استبدل الرقم 22 في المعادلات برقم اخر صف فيه بيانات عندك ثانياً المعادلات هي معادلات (صفيف ) وليست معادلات عادية لذلك لنتفيذ اي معادلة بعد كتابتها يجب الضغط على ( Ctrl+Shift+ Enter ) و ليس (Enter) وحدها للمزيد حول معادلات الصفيف هذا الفيديو (ركز على الوقت 2:16) منه https://www.youtube.com/watch?v=60fotBhcNRI

لم أفهم شيئاً مما تريد!..................

جرب هذا الملف GR_date.xlsx

هذه المعادلة =INDEX($A1:$D1,COLUMNS($A$1:$D$1)-COLUMNS($A$1:A1)+1)

جرب هذا الملف Book_two.xlsx

الملف يجب ان يكون نموذجاً للعمل من 20 الى 25 اسم وليس اكثر من 1000 صف و ذلك لمتابعة عمل المعادلات وان يحتوي على علامات وليس اصفاراً علامة النجاح (تم وضعها في الخلية Z3 و يمكن تغييرها اذا لم تكن المطلوبة) جرب هذا الملف r1_salim.xlsx

تفضل Currancy Rate_1.xlsx

جرب هذا الملف Special_days.xlsx

جرب هذه المعادلة =INDEX($A$2:$D$13,MATCH($H$3,$A$2:$A$13,0),MATCH($H$2,$A$1:$D$1,0))

تم التعديل على الماكرو كما تريد Option Explicit Sub tranfere_data() Dim S As Worksheet, T As Worksheet Dim RGG5S As Range, RGB11S As Range, RGAS As Range Dim r%, x1%, x2% Set S = Sheets("SOURCE_SH"): Set T = Sheets("TARGET_SH") Set RGG5S = S.Range("G5").Resize(5) Set RGB11S = S.Range("B11").Resize(4) With T .Range("G6").Resize(5).ClearContents .Range("B12").Resize(4).ClearContents .Range("a18").Resize(18, 7).ClearContents .Rows.Hidden = False End With x1 = Application.CountA(RGG5S) x2 = Application.CountA(RGB11S) If x1 + x2 <> 9 Then MsgBox "Insufficient data in SOURCE_SH" & Chr(10) & _ RGG5S.Address & Chr(10) & "OR" & Chr(10) & _ RGB11S.Address Exit Sub End If Set RGAS = S.Range("A21").CurrentRegion.Columns(1) r = Application.CountA(RGAS) If r = 1 Then MsgBox "No data in SOURCE_SH to transfere" Exit Sub End If Set RGAS = S.Range("a22").Resize(r - 1, 7) With T .Range("G6").Resize(5).Value = RGG5S.Value .Range("B12").Resize(4).Value = RGB11S.Value .Range("A18").Resize(RGAS.Rows.Count, RGAS.Columns.Count).Value = RGAS.Value .Range("A18:A35").SpecialCells(4).EntireRow.Hidden = True End With End Sub

استبدل اسماء الشيتات (لسهولة نسخ الكود ولصقه الافضل استعمال اللغة الاجنبية في تسمية الصفحات) شيت المصدر الى SOURCE_SH شيت الهدف الى TARGET_SH ونفذ هذا الكود Option Explicit Sub tranfere_data() Dim S As Worksheet, T As Worksheet Dim RGG5S As Range, RGB11S As Range, RGAS As Range Dim r%, x1%, x2% Set S = Sheets("SOURCE_SH"): Set T = Sheets("TARGET_SH") Set RGG5S = S.Range("G5").Resize(5) Set RGB11S = S.Range("B11").Resize(4) With T .Range("G6").Resize(5).ClearContents .Range("B12").Resize(4).ClearContents .Range("a18").Resize(18, 7).ClearContents End With x1 = Application.CountA(RGG5S) x2 = Application.CountA(RGB11S) If x1 + x2 <> 9 Then MsgBox "Insufficient data in SOURCE_SH" & Chr(10) & _ RGG5S.Address & Chr(10) & "OR" & Chr(10) & _ RGB11S.Address Exit Sub End If Set RGAS = S.Range("A21").CurrentRegion.Columns(1) r = Application.CountA(RGAS) If r = 1 Then MsgBox "No data in SOURCE_SH to transfere" Exit Sub End If Set RGAS = S.Range("a22").Resize(r - 1, 7) With T .Range("G6").Resize(5).Value = RGG5S.Value .Range("B12").Resize(4).Value = RGB11S.Value .Range("A18").Resize(RGAS.Rows.Count, RGAS.Columns.Count).Value = RGAS.Value End With End Sub الملف مرفق Transfer_data_.xlsm

قبل اول كلمة Dim في الماكرو اكتب هذا السطر و بذلك يقوم الماكرو بعمله حتى ولو كانت الورقة محمية ActiveSheet.Protect "123", UserInterfaceOnly:=1 ليصبح الماكرو بهذا الشكل Option Explicit Sub get_my_studiants() Application.ScreenUpdating = False '++++++++++++++++++++++++++++++++++++++++++++++++++++++ ActiveSheet.Protect "123", UserInterfaceOnly:=1 '++++++++++++++++++++++++++++++++++++++++++++++++++++ Dim A As Worksheet Dim B As Worksheet Set A = Sheets("ALL_STD") Set B = Sheets("B") Dim col%, r, x, LB LB = B.Cells(Rows.Count, "B").End(3).Row If LB < 5 Then LB = 5 B.Range("a5").Resize(LB - 4, 6).Clear Dim my_clas$: my_clas = B.Range("e2") Dim my_mad$: my_mad = B.Range("K2").Value If my_clas = "" Or my_mad = "" Then GoTo Exit_Sub col = A.Rows(1).Find(my_clas, lookat:=1).Column r = A.Columns(1).Find(my_mad, lookat:=1).Row x = Application.CountIf(A.Columns(1), my_mad) B.Range("b5").Resize(x).Value = _ A.Cells(r, 2).Resize(x).Value B.Range("c5").Resize(x, 3).Value = _ A.Cells(r, col).Resize(x, 3).Value With B.Range("A5").Resize(LB - 4, 6) .Columns(1).Formula = "=if(B5="""","""",max($A$4:a4)+1)" .Columns(1).Interior.ColorIndex = 6 .Borders.LineStyle = 1 .Columns(6).Formula = "=RANK(E5,$E$5:$E$29,0)+COUNTIF($E5:E$5,E5)" .Value = .Value .Font.Size = 26 .Font.Bold = True End With Exit_Sub: Application.ScreenUpdating = True End Sub الملف مرفق My_students_Protected.xlsm