نجوم المشاركات

شكرا جزيلا وبارك الله فيك وغفر الله لنا ولكم بحق هذا الشهر الكريم

تفضل المرفق بعد التعديل بكل طلباتك . Saad-1.rar

بارك الله فيك تمام جزاك الله كل خير..... ورمضان كريم

🤔 يعني تريد ألغاء الدمج للخلايا التي تم دمجها ، مع إعادة القيم لكل خلية !!! تمام ، جرب هذا الماكرو أ واستعمله في حدث عند النقر لأي زر مثلاً :- Sub UnMergeFoksh() Dim ws As Worksheet Dim r As Long, c As Long Dim mArea As Range Dim cellText As String Set ws = ActiveSheet Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual For r = 4 To 20 For c = 2 To 36 If ws.Cells(r, c).MergeCells Then Set mArea = ws.Cells(r, c).MergeArea cellText = ws.Cells(r, c).Text mArea.UnMerge mArea.NumberFormat = "@" mArea.Value = "'" & cellText mArea.HorizontalAlignment = xlCenter mArea.VerticalAlignment = xlCenter End If Next c Next r Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.ScreenUpdating = True End Sub طبعاً اعتقد انك هنا ستستغني عن حدث عند التغيير للورقة السابق .. ويصبح ملفك كالتالي للحدثين مع إضافة زرين . merge cell.xlsm

وعليكم السلام ورحمة الله وبركاته .. بداية أعتقد أن التنسيق الشرطي سيكون عقبة ومشكلة كونه - على حد علمي - لا يوم بالدمج للخلايا كما تريد . لذا ؛ لجأت لإستخدام دالة بسيطة كالتالي :- Sub MergeFokshCells() Dim ws As Worksheet Dim lastRow As Long Dim dayRanges As Variant Dim i As Long, j As Long, startCol As Long Dim d As Long Application.DisplayAlerts = False Set ws = ActiveSheet lastRow = 20 dayRanges = Array(Array(2, 8), Array(9, 15), Array(16, 22), Array(23, 29), Array(30, 36)) For i = 4 To lastRow For d = LBound(dayRanges) To UBound(dayRanges) j = dayRanges(d)(0) Do While j <= dayRanges(d)(1) If ws.Cells(i, j).Value <> "" Then startCol = j Do While j < dayRanges(d)(1) And ws.Cells(i, j).Value = ws.Cells(i, j + 1).Value j = j + 1 Loop If j > startCol Then ws.Range(ws.Cells(i, startCol), ws.Cells(i, j)).Merge ws.Cells(i, startCol).HorizontalAlignment = xlCenter ws.Cells(i, startCol).VerticalAlignment = xlCenter End If End If j = j + 1 Loop Next d Next i Application.DisplayAlerts = True End Sub وتستطيع استدعائها بحدث عند التغيير مثلاً داخل الورقة ، بالشكل التالي :- Private Sub Worksheet_Change(ByVal Target As Range) Call MergeFokshCells End Sub أو حتى في حدث عند الفتح إن أردت بنفس الأسلوب :- Private Sub Workbook_Open() Call MergeFokshCells End Sub جرب وأخبرني بالنتيجة ، طبعاً بعد حفظ الملف بصيغة . جرب دون أرفاقي الملف لتتعرف على النتيجة .