انشاء سيريال نمبر اتوماتيك بشرط محدد

[Ahmed Saad 2017]

برجاء من الاخوة الاعضاء المساعده في عمل كود محدد لعمل سيريال لملف في عمود السيريال بناء علي شرط محدد 

مرسل الملف وصورة للمطلوب 

وشكرا لسيادتكم

ادخال بيانات8465.xlsm

[Ali Mohamed Ali]

تفضل

 

ادخال بيانات8465.xlsm

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

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

هذه المعادلة تكتي في الحلية D11  وتسحب نزولاً

=IF($E11<>"FP",MAX($D$10:D10)+1,"")

 

[Ali Mohamed Ali]

بارك الله فيك استاذى الكريم سليم معادلة رائعة ولكن لابد ان تكون هكذا لعمل الشرط

=IF($E11="FP",MAX($D$10:D10)+1,"")

بارك الله فيك

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

47 دقائق مضت, ali mohamed ali said:

بارك الله فيك استاذى الكريم سليم معادلة رائعة ولكن لابد ان تكون هكذا لعمل الشرط

=IF($E11="FP",MAX($D$10:D10)+1,"")

بارك الله فيك

تصحيح رائع (غلطة مطبعية)

[Ahmed Saad 2017]

شكرا للاخوه الكرام انا محتاج كود vba لان ممكن اضيف صفوف جديده او احذف 

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

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

Option Explicit

Sub Plese_Go()
Dim mY_rg As Range
Dim I%, k%, x%, m%
 If ActiveSheet.FilterMode = True Then
 ActiveSheet.Range("Table2").AutoFilter
 End If
 Range("Table2").Columns(3).ClearContents
 ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=4, Criteria1:= _
        "FP"
        Set mY_rg = Range("Table2").Columns(3).SpecialCells(xlCellTypeVisible)
        x = mY_rg.Areas.Count
     For k = 1 To x
      For I = 1 To mY_rg.Areas(x).Rows.Count
        mY_rg.Areas(k).Rows(I) = m + 1
        m = m + 1
      Next
      Next
ActiveSheet.Range("Table2").AutoFilter
End Sub

الملف مرفق

 

ادخال بياناتNew.xlsm

[أحمد يوسف]

كود ممتاز استاذى سليم ولكن كما ترى بالصورة

كما تلاحظ استاذى الكريم عندما اضع شرط الترقيم متتالى لا يعطى سريال الا لكود واحد فقط كما ترى

ياريت يكون هناك حل

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

 

[Ahmed Saad 2017]

استاذ سليم شكرا جزيلا 

انا جربت الكود للاسف بياخد وقت كبير لانه بينفز كل امر (الفلتر - و السيريال ) 

والشيت الاساسي فوق ال 10000 صف اعتقد هيحتاج وقت كبير جدااااا 

فهل ممكن نعملها بطريقة المصفوفات

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

خطأ بسيط في الكود تمت المعالحة

Option Explicit

Sub Plese_Go()
Dim mY_rg As Range
Dim I%, k%, x%, m%
 If ActiveSheet.FilterMode = True Then
 ActiveSheet.Range("Table2").AutoFilter
 End If
 Range("Table2").Columns(3).ClearContents
 ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=4, Criteria1:= _
        "FP"
        Set mY_rg = Range("Table2").Columns(3).SpecialCells(xlCellTypeVisible)
        x = mY_rg.Areas.Count
     For k = 1 To x
          For I = 1 To mY_rg.Areas(k).Rows.Count
         mY_rg.Areas(k).Rows(I) = m + 1
        m = m + 1
      Next
      Next
ActiveSheet.Range("Table2").AutoFilter
End Sub

الملف

 

 

ادخال بياناتNew_1.xlsm

[Ali Mohamed Ali]

أحسنت استاذ سليم كود ممتاز جعله الله فى ميزان حسناتك

[Ahmed Saad 2017]

شكرااااا جزيلا الكود شغال زي الفل بارك الله فيك 

 

 

تم تعديل ديسمبر 11, 2018 بواسطه Ahmed Saad 2017

[Ahmed Saad 2017]

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