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

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

فينك يا ريس ياسر ..غطسان بقالك فترة فين؟؟؟ لعل غيابك عن إخوانك خير إن شاء الله تقبل تحياتي

أخي الفاضل أسامة975 ممكن تغير اللقب ليكون الاسم مناسب كما هو الحال مع بقية الأعضاء دا مجرد اختيار مش إجبار ...لو عاجبك الاسم فيه رقم 99 مش مشكلة خليه زي ما هو ..أهو بردو أسامة 55 مش بطال بالنسبة لتطوير الملف شوف ايه المطلوب وإن شاء الله الأخوة لن يقصروا معك ... لأن الملف أنت أدرى به منا لأنه عملك الذي لا نفقه فيه شي أي شيء تحتاجه لا تتردد واطرح موضوع جديد واطرح طلبك بشيء من التفصيل والتوصيح مع ملف مرفق ولن تجد إلا إخوان في انتظار مساعدتك على الدوام تقبل تحياتي

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

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

أخي الكريم أحمد الموضوع بسيط هتعمل متغير يمثل ورقة العمل بأي اسم تختاره وليكن Ws اختصار Worksheet أو أي اسم يعجبك والمتغير هيكون من النوع Worksheet ورقة عمل وبعدين تستخدم كلمة For Each وبعدها تذكر اسم المتغير وبعدها حرف الجر In وبعدها المجموعة اللي هتشتغل عليها اللي هي أوراق العمل Worksheets وبتقفل جملة حلقة التكرار بـكلمة Next يليها اسم المتغير المعين لورقة العمل وبين السطرين دول بتبدأ تتعامل مع أسطر الكود أرجو أن يكون الشرح واضح

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

جرب الملف المرفق التالي report.rar

أخي الحبيب ياسر العربي بارك الله فيك وجزاك الله كل خير على كل ما تقدمه من أعمال أعتبرها من الروائع بالمنتدى اسمح لي أن أرد .. وأنقد كعادتي الملف لا يقوم بفك حماية السر لمحرر الأكواد إلا إذا كان امتداد الملف الهدف xls ..فهل من طريقة تجعله يعمل على كل الامتدادات؟ هذه نقطة نقطة أخرى فيما يخص فك حماية أوراق العمل لم تعمل معي رغم أني تركت الملف فترة طويلة ليقوم بالأمر ، حتى مع تحويل الامتداد إلى Xls لم يعمل هذا الجزء أرجو الإيضاح .. يا ورد يا فواح

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

بقيت نقطة أخي الكريم أحمد أن يتم تطبيق الكود على جميع الأوراق بالتالي لابد من حلقة تكرارية لكل أوراق العمل وما بين سطري الحلقة التكرارية يتم وضع السطر أو الأسطر المطلوبة ...

أخي الفاضل عمرو أسامة يرجى تغيير اسم الظهور للغة العربية ، وأهلا بك في المنتدى بين إخوانك ونورت المنتدى بارك الله فيك على تقديم المساعدة الرائعة ... يبدو اننا نعمل على نفس الفكرة وهي دمج النصوص في الأعمدة ولكني استخدمت دالة معرفة لذلك الملف الذي عملت عليه أنت لم يكن فيه خلايا مدمجة في العمودين الأول والثاني وإلا لقابلتك نفس المشكلة الخاصة بالدمج أخي الكريم اسامة يرجى فيما بعد التركيز على ملف واحد فقط لأن هذا يشتت الجهود المبذولة .. فقد تهت قبلنا في ملفينا ولم أكن أعلم أن هناك ملف آخر عموماً إليك كود آخر أسرع من الأول ويعطي نفس النتائج على الملف الذي عملت عليه من البداية وهذا الكود من مكتبة الصرح ..جربته في البداية فأعطاني خطأ بسبب الدمج فقمت بإزالة الدمج واستخدامه مرة أخرى لأنه سريع جداً ويعطي نتائج صحيحة إن شاء الله Public Sub RemoveDuplicates(StartCell As Range, Optional Header As Boolean = False) Dim Table As Range Dim TotalCols As Long Dim ColArray As Variant Dim Col As Long If StartCell.Count > 1 Then Exit Sub Set Table = StartCell.CurrentRegion TotalCols = Table.Columns.Count ReDim ColArray(0 To TotalCols - 1) For Col = 1 To TotalCols ColArray(Col - 1) = Col Next Application.ScreenUpdating = False If Header Then Table.RemoveDuplicates Columns:=(ColArray), Header:=xlYes Else Table.RemoveDuplicates Columns:=(ColArray), Header:=xlNo End If Application.ScreenUpdating = True End Sub Sub RemoveDuplicateRowsA() RemoveDuplicates Range("A1"), True End Sub لو فيه ملف آخر يرجى رفعه مع التوضيح للمطلوب مرة أخرى Check Merged Cells & Remove Duplicate Rows YasserKhalil.rar

أخي الحبيب سعيد المفروض الحاجات الصغيرة دي منتكلمش فيها الفكرة ببساطة إني بعتمد زي ما قلت لك على إخفاء الصفوف .. ونسخ الظاهر فقط من الخلايا.. وطالما أنك تريد إخفاء العمود J يبقا الموضوع أبسط مما تتخيل في بداية الكود نظهر العمود J وننسخ ونرحل المطلوب وفي الآخر نخفيه شفت بسيطة إزاي : شالو كلب مقطقط حطوا قطة مكلبة إليك الكود بعد التعديل البسيط Sub TarhilModified() Dim Ws As Worksheet, Sh As Worksheet, LR As Long Set Ws = Sheet4: Set Sh = Sheet5 Application.ScreenUpdating = False Application.Calculation = xlManual LR = Sh.Cells(Rows.Count, "L").End(xlUp).Row + 1 With Ws .Columns("D:J").Hidden = False .Range("C8:C" & .Cells(Rows.Count, "C").End(xlUp).Row + 1).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True .Range("C8:C" & .Cells(Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Sh.Range("L" & LR).PasteSpecial xlPasteValues .Range("I8:J" & .Cells(Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Sh.Range("M" & LR).PasteSpecial xlPasteValues .Cells.EntireRow.Hidden = False Sh.Range("I" & LR).Resize(1, 3).Value = Array(Ws.Range("M4").Value, Ws.Range("M2").Value, Ws.Range("B4").Value) .Columns("D:H").Hidden = True: .Columns("J:J").Hidden = True Sh.Activate End With Application.CutCopyMode = False Application.Calculation = xlAutomatic Application.ScreenUpdating = True End Sub تقبل تحياتي

ممكن تلغي كل السطور الخاصة بالإعداد وتبقي هذا السطر فقط لتخفيف الكود .. .BlackAndWhite = True

أخي الكريم زياد هلا وضعت رابط الموضوع الموجود به البرنامج لعل أحد الأخوة يكون لديه البرنامج ويوافينا به

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

أخي الكريم أسامة إليك الملف التالي تم الاعتماد على كل الأعمدة من العمود الثاني إلى العمود AS علاوة على العمود BH ... تم تجميع القيم في هذه الأعمدة وحذف الصفوف المكررة بناءً على تلك الأعمدة حمل الملف وفك الضغط وافتح الملف واضغط Alt + F8 ونفذ الإجراء الموجود في النافذة والمسمى DeleteRowsByColumnDuplicates وذلك بالنقر على كلمة Run وانتظر دقيقة واحدة ، ستظهر لك في النهاية رسالة بانتهاء عمل الكود .... إن شاء الله يكون المطلوب Sub DeleteRowsByColumnDuplicates() Application.ScreenUpdating = False Application.Calculation = xlManual Call DetectMergedCells Columns("BI:BI").Delete With Range("BI2:BI" & Cells(Rows.Count, 1).End(xlUp).Row) .Formula = "=ConCat("","",B2:AS2,BH2)" .Value = .Value .NumberFormat = "@" End With Range("A1:BI" & Cells(Rows.Count, 1).End(xlUp).Row).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61), Header:=xlYes Columns("BI:BI").ClearContents Application.Calculation = xlAutomatic Application.ScreenUpdating = True MsgBox "Completed ...", 64 End Sub Private Sub DetectMergedCells() Dim I As Long Application.ScreenUpdating = False Columns("BM:BN").ClearContents For I = 2 To Cells(Rows.Count, 1).End(xlUp).Row With Cells(I, "A") If .MergeCells = True Then Cells(I, "BM").Value = "Merged" Cells(I, "BN").Value = .MergeArea.Cells.Count Cells(I, "BO").Value = .Value .UnMerge: .ClearContents Cells(I, "B").Value = Cells(I, "BO").Value End If End With Next I ActiveSheet.AutoFilterMode = False Range("A1:BN1").AutoFilter Field:=65, Criteria1:="Merged" Columns("E:BL").Hidden = True Columns("BM:BO").ClearContents ActiveSheet.AutoFilterMode = False Cells.EntireColumn.Hidden = False Application.ScreenUpdating = True End Sub Function ConCat(Delimiter As Variant, ParamArray CellRanges() As Variant) As String Dim Index As Long, Rw As Long, Col As Long, Down As Boolean, Rng As Range, Cell As Range If IsMissing(Delimiter) Then Delimiter = "" Index = LBound(CellRanges) Do While Index <= UBound(CellRanges) If TypeName(CellRanges(Index)) = "Range" Then Set Rng = CellRanges(Index) If Index < UBound(CellRanges) Then If TypeName(CellRanges(Index + 1)) <> "Range" Then Down = CellRanges(Index + 1) = "|" End If If Down Then For Col = 0 To Rng.Columns.Count - 1 For Rw = 0 To Rng.Rows.Count - 1 If Len(Rng(1).Offset(Rw, Col).Value) Then ConCat = ConCat & Delimiter & Rng(1).Offset(Rw, Col) End If Next Next Index = Index + 1 Else For Each Cell In Intersect(Rng, Rng.Parent.UsedRange) If Len(Cell.Value) Then ConCat = ConCat & Delimiter & Cell.Value Next End If Else If CellRanges(Index) = "||" Then ConCat = ConCat & Delimiter & "|" Else ConCat = ConCat & Delimiter & CellRanges(Index) End If End If Index = Index + 1 Loop ConCat = Mid(ConCat, Len(Delimiter) + 1) End Function تقبل تحياتي Check Merged Cells & Remove Duplicate Rows Osama.rar

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

عمود تاريخ الإرسال فارغ في معظم الصفوف ..كيف تريد التعامل مع الخلايا الفارغة في هذه الحالة؟

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

جرب تشيل كلمة Large الموجودة بعد كلمة Count .. وخلي كلمة Count بس (ممكن بسبب نسخة الأوفيس القديمة لديك والتي ما زلت متمسكاً بها)

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

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

المرحلة الثانية .. أنا بعتمد الآن على دمج النصوص في الخلايا الموجودة في الصف الواحد .. سؤال الأول : ما هي الأعمدة التي تريد الاعتماد عليها بمعنى أنه لو تكررت القيم في تلك الأعمدة تعتبر الصفوف مكررة ... أنا حاولت ألم الأعمدة كلها من تاني عمود لحد العمود BH لكن ظهر معايا مشكلة جديدة أن هناك أخطاء في المعادلات تسبب توقف عمل الكود في آخر شوية أعمدة ..حلها بسيط باستخدام الدالة IFERROR ...فهل توافق في التعديل على تلك الأعمدة لتخطي المشكلة؟؟

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