ياسر خليل أبو البراء

في العنوان ذكرت الكلمات المتشابهة عموماً بسيطة غير المعادلة بحيث أن الخلية كذا تساوي "غير موجود" وكذلك بقية الخلايا ..

وعليكم السلام أخي الكريم نايف جرب الملف المرفق التالي لعله يفي بالغرض رابط الملف المرفق من هنا

أين هو رابط الموضوع الآخر؟

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

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

والله أخي الكريم لا أتأخر عنك ..كل ما في الأمر أن لدي بعض الشئون الخاصة ، وليس لدي الوقت الكافي ..أنا أتصفح المنتدى بشكل سريع إن شاء الله سأحاول العمل على ملفك قدر استطاعتي

وعليكم السلام أخي الكريم يرجى تغيير اسم الظهور للغة العربية جرب التعديل التالي في كود حدث التغيير في ورقة العمل Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("C2:C65536")) Is Nothing Then VBA.Calendar = vbCalGreg If IsEmpty(Target) Then Target(1, 0).ClearContents Else With Target(1, 0) .Value = Format(Date & " " & Time, Text) .EntireColumn.AutoFit End With End If End If Dim intLR As Integer intLR = Cells.SpecialCells(xlLastCell).Row If Target.Column = 6 Then Dim strdate As String Dim rCell As Range strdate = Format(Target.Value2, "Short Date") 'Sort Range Range("A1:p" & intLR).Select ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("F2:F" & intLR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Sheet1").Sort .SetRange Range("A1:P" & intLR) .Header = xlYes .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With On Error Resume Next Set rCell = Cells.Find(What:=CDate(strdate), After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) On Error GoTo 0 If Not rCell Is Nothing Then rCell.Select: Set rCell = Nothing End If If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("n2:n65536")) Is Nothing Then VBA.Calendar = vbCalGreg If IsEmpty(Target) Then Target(1, 2).ClearContents Else With Target(1, 2) .Value = Format(Date & " " & Time, Text) .EntireColumn.AutoFit End With End If End If End Sub

وعليكم السلام أخي محمد اذهب للتسيق الشرطي ستجد معادلة بسيطة للشروط وهي أن الخلايا تساوي بعضها البعض ولا تكون فارغة واستخدمت دالة AND ..

وعليكم السلام بالتسيق الشرطي جرب الملف التالي تلوين خلية.rar

جزاكم الله خيراً أخي الغالي مختار .. والغبطة محمودة في العلم وكلنا نتعلم من بعضنا البعض ، فكلنا طلاب علم ولسنا بعلماء (بس تعرف أحلى حاجة ايه؟! إني أول واحد أستقبلك رغم إني مش من رواد المكان باستمرار ..لكن سبحان الله شاء الله ذلك ، وما شاء الله كان)

أخي الكريم عاطف هذا الموضوع أريد التعامل معه ولكن يلزمني ملف مصمم بطريقة احترافية لكي يكون مثال واضح للمطلوب .. قم بتصميم ملفك الذي هو بمثابة قاعدة البيانات ..حدد عمود التاريخ وضع تاريخ البداية في خلية ، وتاريخ النهاية في خلية ، وضع الشروط في الخلايا التي ترغبها .. فقط عليك التصميم (ولكن بشكل احترافي ..ابتعد عن التنسيقات العالية فقط قم بتنسيق البيانات بشكل بسيط ومنظم .. اجعل العناوين واضحة .. وضح شكل المخرجات : هل تريد المخرجات لجميع الأعمدة أم أن هناك أعمدة ستقوم باستثنائها ؟) وإن شاء الله إذا تيسر لي الوقت سأقوم بطرح موضوع بهذا الخصوص تقبل تحياتي

الحمد لله الذي بنعمته تتم الصالحات والحمد لله أن تم المطلوب على خير تقبل وافر تقديري واحترامي

أخي الغالي مختار حسين تفضل باستخدام المصفوفات Sub Using_Arrays() Dim Arr As Variant Dim Temp As Variant Dim I As Integer Dim J As Integer Dim P As Integer Dim Cnt As Integer Dim tSum As Double Range("C6:I9").ClearContents Arr = Range("L5:R9").Value ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2) + 1) For I = 2 To UBound(Arr, 1) Cnt = 0: tSum = 0 For J = LBound(Arr, 2) To UBound(Arr, 2) If Not IsEmpty(Arr(I, J)) Then Temp(I - 1, Cnt + 1) = Arr(I, J) Temp(I - 1, Cnt + 2) = Arr(1, J) tSum = tSum + Arr(I, J) P = P + 1 Cnt = Cnt + 2 End If Next J Temp(I - 1, UBound(Temp, 2) - 1) = tSum Cnt = Cnt + 2 Next I Range("C6").Resize(UBound(Temp, 1), UBound(Temp, 2)).Value = Temp End Sub

وعليكم السلام أخي الكريم هلا وضعت شكل النتائج المتوقعة؟؟؟ أي ما هو الشكل المتوقع للنتائج بعد تنفيذ الكود لكي يسهل توضيح المسألة ..؟

بارك الله فيك أخي المميز مختار حسين وجزيت خيراً تقبل وافر تقديري واحترامي

أخي الكريم جرب الملف التالي عله يفي بالغرض إن شاء الله رابط الملف من هنا

إن شاء الله ليلاً إذا لم يتدخل أحد الأخوة سأحاول العمل على طلبك .. تقبل تحياتي

أولاً ما لدي هو حل بالأكواد وليس المعادلات .. هل المطلوب جلب الاسم فقط بناء على الرقم الوظيفي ؟ أم أن هناك بيانات أخرى مطلوب جلبها ...؟ إذا كان هناك بيانات أخرى اذكرها واذكر العمود المصدر لهذه البيانات

وعليكم السلام أخي الكريم أسامة جرب الملف المرفق استبيان 2.rar

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

أعتقد أن الأخ مختار حسين سيحاول تقديم حل لك إن شاء الله .. وفي انتظار حلول من الأخوة الكرام بالمعادلات لتمام الاستفادة

بارك الله فيك أخي الفاضل أبو تامر نتمنى إعادة فتح الموضوع لكن بأسلوب آخر يكون فيه شرح للأكواد ولو شرح بسيط .. لنتعلم شيئاً جديداً للعلم عندي في مكتبتي أكواد مشابهة للتشفير وفك التشفير وأعرف كيفية استخدامها بشكل جيد .. ولكن نريد أن نرتقي في سلم المعرفة لربما نستفيد من الشرح في أمور أخرى تقبل تحياتي

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

جزاكم الله خيراً أخي الغالي جلال أسعى دائماً وأبداً أن أقوم بتعليم إخواني ما أتعلمه ..أقدمه بأسلوب بسيط يسهل على الجميع فهمه وتطبيقه لكي نتعلم ونرتقي وهذا ما أطمحه من جميع المعلمين في هذا المجال تقبل وافر تقديري واحترامي

وعليكم السلام أخي محمد من أين حصلت على تلك البيانات بهذا الشكل؟ الأرقام ليست بأرقام في الواقع .. لذا سيكون من الصعب التعامل قليلاً مع المشكلة قمت بحل جزئي للمشكلة باستخراج تلك الأرقام وتحويلها لأرقام حقيقية .. تبقى فقط أن أستخرج النصوص واستبعاد الأرقام الظاهرة كنصوص إن شاء الله سأصل لحل لها