ادراج سطر في حالة اختلاف القيمة

[محسن33]

السلام عليكم ورحمة الله

لدي 70 الف سطر لخلايا من A1:K70000

مااريدة هو في حالة اختلاف قيمة من العمود A  عن ماتحتها يتم ادراج سطر

بالكود او بالمعادلات

شكرا لكم

 

اوفيسنا.rar

[بن علية حاجي]

السلام عليكم ورحمة الله

راجع الملف المرفق لعل فيه ما تريد (وزيادة)...

بن علية حاجي

أوفيسنا2.rar

[سليم حاصبيا]

بعد اذن اخي بن علية

الكود

Option Explicit


Sub InsertRowsAtValueChange()

Dim WorkRng As Range
Dim i As Long
On Error Resume Next
    Range("a1:a" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(4).EntireRow.Delete
Set WorkRng = Range("a1:a" & Cells(Rows.Count, 1).End(3).Row)
Application.ScreenUpdating = False
For i = WorkRng.Rows.Count To 2 Step -1
    If WorkRng.Cells(i, 1).Value <> WorkRng.Cells(i - 1, 1).Value Then
        WorkRng.Cells(i, 1).EntireRow.Insert
    End If
Next
Application.ScreenUpdating = True
End Sub
Sub Reset()
Range("a1:a" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(4).EntireRow.Delete
End Sub

الملف

 

اوفيسنا salim 1.rar

9 دقائق مضت, بن علية حاجي said:

السلام عليكم ورحمة الله

راجع الملف المرفق لعل فيه ما تريد (وزيادة)...

بن علية حاجي

أوفيسنا2.rar

أخي بن علية

لعدم تكرار ادراج الصفوف الفارغة في كل مرة يضغط المستخدم على الزر يجب اولاً الغاء الصفوف الفارغة قبل المباشرة بادراج صفوف فارغة جديدة

Range("a1:a" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(4).EntireRow.Delete

[محسن33]

الأخ بن علية حاجي والاخ سليم حاصبيا    اشكركم على الاكواد الرائعة

فضلا منكم شرح كود الأخ بن علية حاجي

شكرا لكم