اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

السلام عليكم

أخى الفاضل / سليم

تسلم ايديك على هذه الإبداعات

 

ولاثراء الموضوع هذا كود آخر يعتمد على Array  وبدون عمود مساعد

Sub ragab()
Dim i As Integer
Dim LR As Integer
Dim cl As Range
Dim arr() As Variant
'=========================================
Set WF = Application.WorksheetFunction
LR = Cells(Rows.Count, 1).End(xlUp).Row
'=========================================
For Each cl In Range("A1:A" & LR)
    If Not IsEmpty(cl) Then
        i = i + 1
        ReDim Preserve arr(1 To i)
        arr(i) = cl
    End If
Next
Range("A:A").ClearContents
Range("A1").Resize(i) = WF.Transpose(arr)
Erase arr
End Sub

ازالة الفراغات.rar

  • Like 1
قام بنشر

ما شاء الله

أخى فى الله 

الأستاذ // سليم

أخى فى الله

أستاذى القدير // رجب جاويش

بارك الله فيكم وزادكم الله من فضله

تقبلوا منى وافر الإحترام والتقدير

قام بنشر

أخى الحبيب / محمود الشريف

جزاك الله كل خير أخى الحبيب على هذه الكلمات الطيبة

تقبل أرق تحياتى وتقديرى

قام بنشر

اخى رجب جاويش

اكواد متقنة ومفيدة بارك الله فيك

لى سؤال اخى

هل من الممكن تطبيق الكود على عدة اعمدة بدل العمود a فقط

اشكرك كل الشكر

قام بنشر

السلام عليكم

أخى الفاضل / سعد عابد

تفضل ما تريد

Sub ragab()
Dim i As Integer
Dim x As Integer
Dim LR As Integer
Dim cl As Range
Dim arr() As Variant
'=========================================
Set WF = Application.WorksheetFunction
'=========================================
For x = 0 To 2
LR = Cells(Rows.Count, x + 1).End(xlUp).Row
For Each cl In Range("A1:A" & LR).Offset(0, x)
    If Not IsEmpty(cl) Then
        i = i + 1
        ReDim Preserve arr(1 To i)
        arr(i) = cl
    End If
Next
Range("A1").Offset(0, x).Resize(LR).ClearContents
Range("A1").Offset(0, x).Resize(i) = WF.Transpose(arr)
Erase arr
i = 0
Next
End Sub

ازالة الفراغات2.rar

قام بنشر

إخوانى فى الله

بارك الله فيكم وزادكم الله من فضله

وبعد إذن الأستاذ // سليم

وبعد إذن استاذى القدير // رجب جاويش

 

كود لإزاله الخلايا الفارغة لعمود بيانات يمكن التعديل عليه

الكود من اعداد الأستاذ القدير // عبد الله المجرب

Sub حامل_المسك()
    Range("B1:C1000").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    Range("A1").Select
End Sub

وتقبلوا منى وافر الإحترام والتقدير

قام بنشر

استاذ محمود /بعد السلام ورحمة الله

الكود الذي ذكرته للاستاذ العلاّمة عبدالله ،فعّال جداً ولكنه يحذف كل الصفوف الفارغة من العامود الهدف و يحذف ايضاً الصفوف التي تقابلها من جميع الأعمدة حتى لو لم تكن فارغة/أرجو ان تكون قد فهمت قصدي

قام بنشر

السلام عليكم استاذ رجب

تعديل ممتاز على الكود جزاك الله خيراً

و لكن عندي اقتراح/دع المستخدم نفسه يحدد عدد الأعمدة الهدف من خلال رقم يوضع في خلية معيّنة

for x=0 to y       حيث  y=a1    وهو رقم يختاره المستخدم و يوضع في بداية الكود

قام بنشر

اخى رجب جاويش

هو المطلوب شكرا شكرا

والله اهم من وجود العلم  هو وجود الاخلاق اخلاقك عاليه بارك الله فيك

اشكرك

قام بنشر

أخى الحبيب / محمود الشريف

جزاك الله كل خير

 

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

أما هذه الأكواد تقوم بتجميع البيانات بدون الفراغات من غير حذف للصفوف الفارغة

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information