Ali Mohamed Ali

تفضل يمكنك فقط استخدام هذا الكود ...وانا لا ارى اى اهمية او وجود اصلاً لهذا الفورم Sub OneCell() Sheets("Sheet1").Range("B4:B100").Value = Sheets("Sheet1").Range("A4:A100").Value End Sub تواتي6.xlsm

فقط عليك استخدام هذه المعادلة =IFERROR(INDEX($A:$A,MATCH($E4,$B:$B,0)),"") aa.xls

وعليكم السلام بالطبع لا يمكن عمل هذا الا بدالة معرفة Option Explicit Function Lookup_concat(Search_string As String, _ Search_in_col As Range, Return_val_col As Range) Dim i As Long Dim result As String For i = 1 To Search_in_col.Count If Search_in_col.Cells(i, 1) = Search_string Then result = result & "," & Return_val_col.Cells(i, 1).Value End If Next Lookup_concat = Trim(result) End Function ووضع هذه المعادلة بداية من الخلية H3 سحباً للأسفل =Lookup_concat($G3,$A$2:$A$700,$B$2:$B$700) Test1.xlsm

تفضل لك ما طلبت بعد اذن الأستاذ الرائد اخر عملية وعدد الشهور1.xlsx

تفضل هذه الفيديوهات ستساعدك فى القضاء عليه https://www.youtube.com/watch?v=TJadvSU4KKc https://www.youtube.com/watch?v=Cxcg3hXlE1A

وعليكم السلام-لك ما طلبت سجل المدرسة2020.xls

وعليكم السلام -على الرغم انك لم تقم برفع ملف موضح فيه كل المطلوب الا انك يمكنك استخدام هذا Public Function XLookup(ByVal vTable As Variant, _ ByVal vResult As Variant, _ ParamArray vKeyVals() As Variant) As Variant Const cRoutine As String = "XLookup" Dim oLo As ListObject 'Table containing data Dim vKeys As Variant 'vKeyVals internal version Dim sCol As String 'Column Address Range to search Dim vKey As Variant 'Key(s) to find in Column(s) Dim lKey As Long 'Current key Dim lRow As Long 'Found Row Dim lCol As Long 'Found Column Dim sAddTxt As String 'Additional Error Text ' Error Handling Initialization On Error GoTo ErrHandler Set XLookup = Nothing ' Check Inputs and Requisites ' Table Select Case TypeName(vTable) Case Is = "ListObject": Set oLo = vTable Case Is = "Range": Set oLo = vTable.ListObject Case Else: Set oLo = ActiveSheet.Evaluate(vTable).ListObject End Select ' Return Column If TypeName(vResult) = "Range" Then vResult = vResult.Value2 ' Search Keys If UBound(vKeyVals) = -1 Then Err.Raise DspError, , "#Key(s) required" ' When called by VBA, ParamArrays sometimes are stuffed in the first element If IsArray(vKeyVals(LBound(vKeyVals))) Then _ vKeys = vKeyVals(LBound(vKeyVals)) Else _ vKeys = vKeyVals ' Procedure With oLo If Not .DataBodyRange Is Nothing Then ' Just 1 key - Use Worksheet.Function because it is fastest w/1 Key If LBound(vKeys) = UBound(vKeys) Then vKey = vKeys(UBound(vKeys)) If IsNumeric(vKey) Then vKey = CDbl(vKey) lRow = Application.WorksheetFunction.Match( _ vKey, _ .ListColumns(1).DataBodyRange, _ 0) ' More than 1 key - Use Worksheet.Evaluation because it is fastest w/multiple keys Else ' Concatenate Key Values and Search Column Addresses For lKey = LBound(vKeys) To UBound(vKeys) lCol = lCol + 1 sCol = IIf(sCol <> vbNullString, sCol & " & ", vbNullString) & _ .ListColumns(lCol).DataBodyRange.Address ' Determine Key Value If TypeName(vKeys(lKey)) = "Range" Then _ vKey = vKey & vKeys(lKey).Value2 Else _ If IsDate(vKeys(lKey)) Then _ vKey = vKey & CLng(vKeys(lKey)) Else _ vKey = vKey & vKeys(lKey) Next ' Find Row # by Evaluating MATCH within the Table's worksheet lRow = .Parent.Evaluate("=Match(""" & vKey & """," & sCol & ",0)") End If ' Get Column # lCol = .ListColumns(vResult).Index ' Return result Set XLookup = .ListRows(lRow).Range(lCol) End If End With ErrHandler: If Err.Number > 0 Then ' Create sAddTxt (Additional Error Text) if needed Select Case Err.Number Case Is = 9: sAddTxt = "Column " & vResult & " not found in " & oLo.Name Case Is = 13, 1004: sAddTxt = "Key(s) " & Join(vKeys, ",") & " not found" Case Is = 424: sAddTxt = "Table not found" End Select ' Customize Errors based on UDF of VBA caller If TypeName(Application.Caller) = "Range" Then 'Called from UDF MLookup = CVErr(xlErrRef) Debug.Print cRoutine & ":" & Err.Description & vbLf & sAddTxt Else 'Called from VBA (most likely) Select Case Err.Number Case Is = 13, 1004: 'Key(s) not found. Log Error Debug.Print cRoutine & Err.Description & vbLf & sAddTxt Case Else: 'Pop Up Error Message Select Case DspErrMsg(cModule & "." & cRoutine, sAddTxt) Case Is = vbAbort: Stop: Resume 'Debug mode - Trace Case Is = vbRetry: Resume 'Try again Case Is = vbIgnore: 'End routine End Select End Select End If End If End Function أو يمكنك مشاهدة هذا الرابط Custom Excel XLOOKUP Function أو هذا الرابط UDF: XLOOKUP – Using VLOOKUP for left AND right searches وهذا ايضا فيديو للشرح https://www.youtube.com/watch?v=Tbqh4_HcUlI

كده بالفعل ايقنت ان المشكلة لديك انت فيجب عليك العمل على حلها بنفسك فكما ترى من الصور بالترتيب فالملف يعمل معى بكفاءة عالية- بارك الله فيك ويكفى هذا فقد اخذ الموضوع اكبر من حجمه ويجب الغلق

جرب هذا طبعا بعد اذن الأستاذ الرائد , فممكن ان تكون هذه مشكلة من عندك فملف الأستاذ الرائد يعمل بكفاءة عموماً -تفضل تم التعديل على نفس اكوادك شششششش1.xlsm

أحسنت استاذ منير عمل ممتاز وشرح وافى وكافى

اجعل تنسيق الخلايا هكذا [$-2000000]0

بارك الله فيك استاذنا الكريم وجزاك الله كل خير

أحسنت استاذ سليم كود ممتاز اعتقد انه ادى المطلوب واكثر مما كان يريد صاحب المشاركة بارك الله فيك وزادك الله من فضله

وعليكم السلام-فقط عليك بإستخدام هذه المعادلة بالتنسيقات الشرطية =OR($E7="الجمعة",$E7="السبت") Condation Fromat.xlsx

يمكنك استخدام هذه المعادلة بعمود الفعلى بداية من الخلية D2 =IF(A2=B2,C2,IF(OR(C2-B2<0,$C2<MAX(A2:B2)),MAX(A2:B2),C2-B2)) تحويل السالب لى موجب1.xls

السلام عليكم -بالنسبة للطلب الأول , يمكنك استخدام هذه المعادلة =SUMIFS($C$2:$C$17,$A$2:$A$17,$F2,$D$2:$D$17,LETTEROUT($G2)) أما الطلب الثانى فهو يحتاج هذه المعادلة =MID(F11,1,FIND("ل/م",F11)-1) بعد الاضافة.xlsm

وعليكم السلام -يمكنك استخدام هذا الكود Private Sub TextBox1_AfterUpdate() If Len(TextBox1.Value) < 5 Then MsgBox "يجب عليك ادخال 5 حروف أو أكثر" End If End Sub ListBox1.xlsm

حاول على موقع اخر وسأرفعه لك ان شاء الله على ميديا فاير شكرا لك استاذ منير تم تثبيت رابط البرنامج بالمشاركة الرئيسية

تمام استاذنا الكريم سننتظر البرنامج -احسنت ياريت يكون على ميديا فاير

وعليكم السلام-تفضل نموذج.xlsm

وعليكم السلام وبما انك لم تقم برفع ملف مدعم بشرح وافى عن المطلوب ,فكان عليك استخدام خاصية البحث بالمنتدى قبل رفع مشاركتك فبه كنوز : كيفية ترقيم الصفحات من عدد معين

أحسنت اخى الكريم عمل رائع بارك الله فيك وزادك الله من فضله

وعليكم السلام -كان هناك خطأ بالمعادلة وتم تصحيحه -تفضل وهو انك قمت بتعديل وتغيير أعمدة مصدر جلب البيانات بالمعادلة -لاحظ الفرق بنفسك Std_7.xlsx

بارك الله فيك استاذ محمد وزادك الله من فضله

وبما أنك لم تقم برفع ملف موضح عليه المطلوب بكل دقة فلم لا تقوم بإستخدام خاصية البحث بالمنتدى فبه كنوز فتفضل طلبك : تجميع بيانات من صفحات متعددة بصفحة واحده بشكل اتوماتيك طلب تجميع اكثر من ورقة في ورقة جديدة في نفس ملف الاكسيل تجميع شيتات تجميع بيانات شيتات إلى شيت رئيسي