تغيير مدى كود التوزيع كي يكون متغيرا على حسب البيانات الفعلية

[مصطفى محمود مصطفى]

السلام عليكم

هذا الكود لاحد الاخوة في هذا المنتدى لم اتذكر اسمه جزاه الله خيرا يقوم بالفرز بثلاث شروط اولا ثم يوزع البيانات على عدد محدد المذكور في الخلية h1 لكن المشكلة انه يضيف الفرز باعداد كبيرة حسب المدى المذكور بالكود وانا اردت ان يقتصر التوزيع على الاعداد الفعلية الموجودة في الخلية a1 لان الاعداد متغيرة لكن كحد اعلى المدى 1000 فالكود يوزع ال 1000 جميعا  هل يمكن التعديل على الكود بان يوزع فقط البيبانات الفعلية على العدد المذكور في الخلية   a1كي تكون متقاربة  ..ولكم وافر احترامي.

Moustsfa_New.xlsm

[حسين مامون]

جرب الماكرو هكذا ربما يفي بالغرض

Sub Macro1()
Application.ScreenUpdating = False

Dim Cont As Integer
Dim lr
Cont = Range("h1").Value
lr = Range("b" & Rows.Count).End(xlUp).Row

With Range("b4:h" & lr)
    .Sort .Columns(4), xlAscending
    .Sort .Columns(3), xlAscending
    .Sort .Columns(6), xlDescending
End With

With Range("h4:h" & lr)
    .FormulaR1C1 = "=MOD(ROW()-4," & Cont & ")+1"
    .Value = .Value
End With

With Range("b4:h" & lr)
    .Sort .Columns(7), xlAscending
End With
Application.ScreenUpdating = True
End Sub

 

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

للمرة الــ  100 بعد الألف (يجب ان يكون الجدول مستقلاً عن كل الخلايا التي لا علاقة  له بها
1- للمرة الأخيرة اقوم بالمساعدة دون هذه الميزة (تم ادراج صف فارغ لتحقيق ذلك الصف رقم 3 مخفي)

الكود

Sub Salim_Macro()
Application.ScreenUpdating = False
Dim My_max%
Dim Cont As Integer
Dim Ro
Cont = Range("H1").Value

My_max = Range("A4").CurrentRegion.Rows.Count
If My_max = 1 Then GoTo End_Me

With Range("A4").CurrentRegion. _
  Offset(1).Resize(My_max - 1) _
  .Columns(1)
  .ClearContents
  .Offset(, 7).ClearContents
 End With
With Range("B4:H" & My_max + 3)
   .Sort .Columns(4), xlAscending, Header:=1
   .Sort .Columns(3), xlAscending, Header:=1
   .Sort .Columns(6), xlDescending, Header:=1
End With
Range("a5").Resize(My_max - 1) = _
Evaluate("Row( 1:" & My_max - 1 & ")")

Range("H5").Resize(My_max - 1).Formula = _
"=INT((ROWS($A$1:A1)-1)/" & Cont & ")+1"

Range("A4:H" & My_max).Value = _
Range("A4:H" & My_max).Value
End_Me:
Application.ScreenUpdating = True
End Sub

الملف مرفق

Moustsfa_Sort.xlsm

[مصطفى محمود مصطفى]

الاستاذ سليم المحترم

اعتذر عن الخطا

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

المطلوب ان يكون التوزيع محدد على الخلية H1 اذا كانت 4 يعني يتوزع البيانات على  4 ولا يتعداها لان فقط هؤلاء الاربعة لهم حق التدقيق في جميع البيانات ويمكن الزيادة الى اكثر من عشرة ويمكن اقل من 3 حسب حجم البيانات والتحكم بالاعداد كما ذكرت من الخلية H4. اما التوزيع كصفوف يعتمد على الخلية A1 يعني 30 لايتجاوز ولايقل عنها . بالاضافة هناك فرز قبل التوزيع حتى يكون التوزيع كما مطلوب وهو تفرز البيانات اولا  في العمود E ومن ثم فرز حسب الاسم عمودD  ومن ثم فرز حسب عمود Gمن الاكبر للاصغر

بعدها ياتي كود التوزيع 

حفظكم الله ورعاكم

Moustsfa_New _TH.xlsm

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

مجدداً حلايا لا علاقة لها بالجدول تضاف اليه

 

هذا الملف يحتوي على صفحتين (اختر ما تريد ) كل واحد الماكرو الخاص بها

 

My_test.xlsm

[مصطفى محمود مصطفى]

الاستاذ سليم المبدع دائما جزاكم الله خيرا

 انا اعتذر مرة ثانية

والعمود عملته كشرح توضيحي لايصال الفكرة 

الكودان يعملان بشكل صحيح

لكم وافر احترامي وتقديري