لثالث مرة اريد شرح كود

[محسن33]

Sub insert_rows()
Dim i%, k%
Application.ScreenUpdating = False
i = Cells(Rows.Count, 1).End(3).Row
 Do Until i = 1
If Range("a" & i) = "" Then
 Rows(i).Delete
 End If
  i = i - 1
Loop
'==========================
k = Cells(Rows.Count, 1).End(3).Row
Do Until k = 2
If Range("a" & k) <> Range("a" & k - 1) Then
 Rows(k).Insert
 End If
   k = k - 1
 Loop
 Application.ScreenUpdating = True
  End Sub

 

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

Sub insert_rows()
'هذه الجزئية تقوم بالإعلان بالمتغيرات المستعملة في الكود
Dim i%, k%
'هذا الأمر خاص بتوقيف تحيين العمليات
Application.ScreenUpdating = False

'  هذه الجزئية من الكود تقوم بحذف كل الصفوف التي تكون فيها_
'خلايا العمود الأول فارغة بداية من آخر خلية في العمود إلى غاية الصف الأول
'------------------------------------
i = Cells(Rows.Count, 1).End(3).Row
Do Until i = 1
  If Range("a" & i) = "" Then
    Rows(i).Delete
  End If
  i = i - 1
Loop
'------------------------------------

' هذه الجزئية من الكود تقوم بإدراج صف بين صفي كل خلية من العمود الأول والخلية_
'التي قبلها إذا كانت قيمهما مختلفة بداية من آخر خلية في العمود إلى غاية الصف الثاني
'------------------------------------
k = Cells(Rows.Count, 1).End(3).Row
Do Until k = 2
  If Range("a" & k) <> Range("a" & k - 1) Then
    Rows(k).Insert
  End If
  k = k - 1
Loop
'------------------------------------

'هذا الأمر خاص بمباشرة تحيين العمليات
Application.ScreenUpdating = True

End Sub

والصبر جميل

[محمد الورفلي1]

شكراً للاستاذ بن علية

تم تعديل أكتوبر 3, 2017 بواسطه محمد الخازمي

[محسن33]

الاخ بن علية مشكور على شرح الكود

بس سؤال هل يعمل الكود على عدد صفوف في حدود 400 الف صف؟؟؟؟؟؟؟؟؟

لاني جربتة لم يعمل

يرجى المساعدة

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

السلام عليكم

الان, محسن33 said:

الاخ بن علية مشكور على شرح الكود

بس سؤال هل يعمل الكود على عدد صفوف في حدود 400 الف صف؟؟؟؟؟؟؟؟؟

لاني جربتة لم يعمل

يرجى المساعدة

جرب تبديل الجزئية في الكود :

Dim i%, k% 

بالجزئية :

 Dim i As Long, k 

أرجو أن يفي هذا الغرض المطلوب...

بن علية حاجي