أحمد عياد - أبو علي

20 ساعات مضت, سليم حاصبيا said:

الخلل كما ذكرت لك هو في السطر For حبث ان الرقم بجب ان يكون 284 و ليس 183

قمت بتجربة ذلك، ولم تكن النتيجة صحيحة وكاملة، كذلك قمت بزيادة الرقم الى أكثر من ذلك بكثير وبقيت نفس المشكلة.

في ٥‏/٤‏/٢٠١٦ at 14:49, ياسر خليل أبو البراء said:

أخي العزيز أحمد

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

For i = 2 To 183

استخدم السطر التالي بدلاً من هذا السطر

For i = 183 To 2 Step -1

 

جزاك الله خير أخي وأستاذي الفاضل أبو البراء

1 ساعه مضت, سليم حاصبيا said:

استبدل الرقم 183 في السطر   For i = 2 To 183 بـ 284

اليك الكود التالي الذي يقوم بنفس العمل و اسرع بكثير 

حيث انه يقوم بتجميع كل الاعمدة المطلوبة وحذفها دفعة واحدة

Sub Delete_Zero()
      Dim rg_to_del As Range, i As Integer
       Application.ScreenUpdating = False
      For i = 2 To 284
    If Cells(284, i) = 0 Then
            If rg_to_del Is Nothing Then
             Set rg_to_del = Cells(284, i)
             Else
             Set rg_to_del = Union(Cells(284, i), rg_to_del)
            End If
     End If
        Next i
       rg_to_del.EntireColumn.Delete
       
    Application.ScreenUpdating = True
End Sub

 

بارك الله بك أستاذي الفاضل سليم على هذا الجهد الرائع.

وكي أزداد علما ومعرفة هل لك ان تشرح لي الخلل الذي كان في المعادلة التي كنت استخدمها؟

بوركت...

أساتذتي الأفاضل:

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

وجزاكم الله خيراً

  () Sub Delete_Zero
  
   For i = 2 To 183
   If Cells(284, i) = 0 Then
       Cells(284, i).EntireColumn.Delete
       
       End If
       Next i
       
    
End Sub

Delete zero.rar

16 ساعات مضت, توكل said:

يبدو أنك قد نسيت المرفق أخي أحمد

 

بارك الله بك أخي، يبدو ان هناك مشكلة في تحميل الملف

16 ساعات مضت, ياسر خليل أبو البراء said:

أخي الكريم أحمد عياد

قم بالإطلاع على رابط الموضوع التالي من هنا

الرابط من هنا

أخي وأستاذي الكريم أبو البراء

جزاك الله عني خير الجزاء

هذا هو المطلوب

بارك الله بك، وزادك علما وفضلا...  

أساتذتي وإخوتي الخبراء

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

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

والمرفق يوضح أكثر

شاكرا لكم إهتمامكم...

أخي الكريم

لا يوجد ملف مرفق

38 دقائق مضت, alamrif6 said:

الله يعطيك العافية تمام

بس ابي اعرف الطريقة لان عندي شيتتات كثير  واحتاج التعديل عليهم

الله يعافيك أخي الكريم...

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

في ١٥‏/٣‏/٢٠١٦ at 13:42, أحمد عياد - أبو علي said:

الاخوة الاساتذة والخبراء الافاضل

السلام عليكم جميعا

إستكمالا للموضوع أعلاه، هل من الممكن ان يتم حذف الأعمدة التي لا تحتوي على قيم أكبر من صفر  في sheet1  قبل البدء بعملية الترحيل الى sheet2؟ كذلك هل ممكن ان يتم دمج خلايا كل رقم في  العمود C الشيت الثانية sheet2 بحيث تصبح خلية واحدة مدمجة تحتوي على رقم الزبون؟

 

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

Transfer Data YasserKhalil.rar

الإخوة الأكارم

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

ألا يوجد حل لهذا الموضوع؟

بارك الله بكم

أخي الكريم

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

أرفقت لك حلا مقتبسا، أرجو ان يكون هو المطلوب...

القاعدة if.rar

الاخوة الاساتذة والخبراء الافاضل

السلام عليكم جميعا

إستكمالا للموضوع أعلاه، هل من الممكن ان يتم حذف الأعمدة التي لا تحتوي على قيم أكبر من صفر  في sheet1  قبل البدء بعملية الترحيل الى sheet2؟ كذلك هل ممكن ان يتم دمج خلايا كل رقم في  العمود C الشيت الثانية sheet2 بحيث تصبح خلية واحدة مدمجة تحتوي على رقم الزبون؟

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

Transfer Data YasserKhalil.rar

جزاكم الله خيرا جميعا...

استكمالا للموضوع، هل من الممكن ان يتم حذف الاعمدة التي تحتوي على القيم الصفرية (الخالية من أرقام اكبر من 0) في sheet1  قبل البدء بعملية الترحيل الى sheet2؟ كذلك هل ممكن ان يتم دمج خلايا كل رقم في  العمود C الشيت الثانية sheet2 بحيث تصبح خلية واحدة مدمجة تحتوي على رقم الزبون؟

مثال على الدمج في المرفق

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

Transfer data 123.rar

38 دقائق مضت, ياسر خليل أبو البراء said:

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

إليك الكود التالي يوضع في موديول عادي

Sub TransferUsingArrays()
    Dim a, aOutput, iCol As Long, iRow As Long, iLooper As Long
    
    With Worksheets("Sheet1")
        a = .Range("A1").CurrentRegion
    End With
    
    ReDim aOutput(1 To UBound(a) * UBound(a, 2), 1 To 12)
    
    For iCol = 2 To UBound(a, 2)
        For iRow = 2 To UBound(a)
            If a(iRow, iCol) > 0 Then
                iLooper = iLooper + 1
                aOutput(iLooper, 1) = iCol - 1
                aOutput(iLooper, 3) = a(1, iCol)
                aOutput(iLooper, 9) = a(iRow, 1)
                aOutput(iLooper, 12) = a(iRow, iCol)
            End If
        Next iRow
    Next iCol
    
    Sheet2.Cells(2, "A").Resize(iLooper, 12) = aOutput
End Sub

اضغط من لوحة المفاتيح Alt + F8 هيظهر لك نافذة الماكروهات الموجودة لديك اختر الماكرو المسمى TransferUsingArrays وانقر على Run ولاحظ سرعة التنفيذ ..

يمكنك التأكد من سرعة الأداء بتنفيذ الكود على بيانات أكثر وليكن 20000 صف على سبيل المثال لتتأكد من سرعة أداء الكود باستخدام المصفوفات

تقبل تحياتي

 

 

Transfer Data YasserKhalil.rar

جزاك الله خيرا أخي ياسر وبارك الله بك...

جزاك الله خيرا أخي ابو عيد وبارك الله بك...

21 ساعات مضت, أبوعيد said:

وعليكم السلام

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

أخي وكما هو معمول به وحسب التعليمات الرجاء تغيير اسم ظهورك إلى اللغة العربية فضلا لا أمرا

 

يوجد حل إن شاء الله ولكن لكثرة انشغال الأعضاء يمكن أن موضوعك لم ينتبه له أحد 

الرجاء المعذرة وطول بالك

تفضل جرب هذا الحل

افتح شيت 2 ثم اضغط transfer

Transfer data1.rar

جزاك الله خير اخي بخصوص التوضيح بالنسبة لإسم الظهور...

وبخصوص الملف المرفق فلا يوجد به شيء، فهو كما هو، ليس به حل...

السلام عليكم جميعا:

الاخوة الخبراء :

ألا يوجد حل لهذا الموضوع؟ أرجو المساعدة،فأنا في أمس الحاجة الى حل...

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

الإخوة الافاضل:

أرجو مساعدتي في إيجاد حل للملف المرفق، حيث أني اريد ترحيل البيانات من sheet1 الى sheet2 بحيث تكون مرتبة في أعمدة محددة حسب المثال الموضح في sheet2، مع إستثناء القيم الصفرية (لا يتم ترحيلها)

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

Transfer data.rar