تصفية البيانات لأكثر من عمود

[Alsalim1]

شباب كيف أعمل تصفية للبيانات لأكثر من عمود في المثال المرفق أريد البيانات التي بها أرقام أكبر من الصفر في كل الأعمدة وليس عمود واحد وفقط في المثال المرفق أريد يظهر لي الموظفين أرقام : 2 ، 4 ، 6 ، 7 ، 8

تصفية البيانات.rar

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

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

Sub give_data()
Dim i%, k%, m%
i = 2
m = 2
Do Until Cells(i, 1) = vbNullString
 For k = 1 To 3
   If Cells(i, 1).Offset(0, k) <> 0 Then
     Cells(m, "f") = Cells(i, 1).Value
     m = m + 1
    Exit For
   End If
   Next
   i = i + 1
  Loop
End Sub

 

[Alsalim1]

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

 

 

تصفية البيانات.rar

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

تم التعديل

 

تصفية البيانات salim.rar

[Alsalim1]

جداً جداً جداً رائع بس استاذ إذا فيه إضافة أعمدة كالمثال المرفق ماذا أغير في الكود وإذا بالإمكان تظهر العناوين بالكود يكون جداً ممتاز

تصفية البيانات.rar

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

في المثال عندك

1-انسخ العناوين الى النطاق K1:S1

2- انسخ هذا الكود ثم قم بتنفيذه

Option Explicit

Sub give_data()
Dim i%, k%, m%
i = 2
m = 2
Range("K2").CurrentRegion.Offset(1).ClearContents
Do Until Cells(i, 1) = vbNullString
 For k = 1 To 8
   If Cells(i, 1).Offset(0, k) <> 0 Then
     Cells(m, "k").Resize(, 9).Value = Cells(i, 1).Resize(, 9).Value
     m = m + 1
    Exit For
   End If
   Next
   i = i + 1
  Loop
End Sub

 

 

 

[Alsalim1]

جداً رائع أشكرك على جهدك بس استاذ خلينا نتعلم إذا أضفت صفوف أو أعمدة أكثر من يكون التعديل في الكود

[Alsalim1]

استاذ ما زلت أنتظر أتعلم منك لكيفية التغيير في الكود في حالة إضافة صفوف أو أعمدة

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

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

استاذ ما زلت أنتظر أتعلم منك لكيفية التغيير في الكود في حالة إضافة صفوف أو أعمدة

1-عدد الصفوف لا قيمة له المهم الا تكون هناك خلايا فارغة قي العامود A

2-تأخذ قيمة k  في الحلقة التكرارية من 1 الى عدد الاعمدة ناقص 1 

3- في جملة (Resize(, 9  تستبدل الرقم 9 بعدد الاعمدة

4- تستبدل اسم العامود "K" في الجملة ("Cells(m, "k بالعمود الذي تريد ان تظهر فيه البيانات (يجب الا يكون ملاصقاً لاخر عامود فيه البيانات الرئيسية)

   مثلاً ("Cells(m, "W

[Alsalim1]

كثير أشكرك استاذ بارك الله تعالى فيك في ميزان حسناتك بإذن الله تعالى حقيقة تعلمت منك

[Alsalim1]

استاذ إذا في القائمة اسم الموظف وأريد أن يظهر اسم الموظف نفس الرقم الوظيفي الذي يوجد فيه رقم غير الصفر كيف يكون الكود

تصفية البيانات.rar

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

الكود

Option Explicit


Sub give_data()
Dim i%, k%, m%
i = 2
m = 2
Range("L2").CurrentRegion.Offset(1).ClearContents
Do Until Cells(i, 1) = vbNullString
 For k = 2 To 9
   If Cells(i, 1).Offset(0, k) <> 0 Then
     Cells(m, "L").Resize(, 10).Value = Cells(i, 1).Resize(, 10).Value
     m = m + 1
    Exit For
   End If
   Next
   i = i + 1
  Loop
End Sub

 

[Alsalim1]

جداً رائع أيها الاستاذ العزيز في ميزان حسناتك بإذن الله تعالى من علمني حرفاً صرت له عبداً جداً جداً جداً أنت رائع ليتني مثلك 

[Alsalim1]

في 11/22/2017 at 12:17, سليم حاصبيا said:

الكود

Option Explicit


Sub give_data()
Dim i%, k%, m%
i = 2
m = 2
Range("L2").CurrentRegion.Offset(1).ClearContents
Do Until Cells(i, 1) = vbNullString
 For k = 2 To 10
   If Cells(i, 1).Offset(0, k) <> 0 Then
     Cells(m, "N").Resize(, 11).Value = Cells(i, 1).Resize(, 11).Value
     m = m + 1
    Exit For
   End If
   Next
   i = i + 1
  Loop
End Sub

 

مرحبا استاذ كيفك 

من فضلك لما أستخدم الكود تظهر لي مشكلة لاحظ المرفق بعد ما تضيف نفس الكود في هذه المشاركة

Difference.rar

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

1 ساعه مضت, Alsalim1 said:

مرحبا استاذ كيفك 

من فضلك لما أستخدم الكود تظهر لي مشكلة لاحظ المرفق بعد ما تضيف نفس الكود في هذه المشاركة

Difference.rar

انا شخصباً لم الاحظ الفرق

ممكن تشرحه لي

[Alsalim1]

1- تظهر الملاحظة المرفقة لما أكتب الكود 

2- تنحذف البيانات الرئيسية عن تشغيل الماكرو ولا يتنفذ الكود

[Alsalim1]

استاذ ما زلت أنتظر الرد

[Alsalim1]

شباب ما زلت أنتظر

[Alsalim1]

شباب ما زلت أنتظر

[Alsalim1]

استاذ ما زالت المشكلة قائمة عندي

[Alsalim1]

مرحبا شباب كيفكم

 

الكود في الاقتباس جداً رائع وشغال إلى أن أوصل إلى العمود رقم 11 ما أدري ما هي المشكلة

في ١٥‏/١١‏/٢٠١٧ at 14:21, سليم حاصبيا said:

في المثال عندك

1-انسخ العناوين الى النطاق K1:S1

2- انسخ هذا الكود ثم قم بتنفيذه

Option Explicit

Sub give_data()
Dim i%, k%, m%
i = 2
m = 2
Range("K2").CurrentRegion.Offset(1).ClearContents
Do Until Cells(i, 1) = vbNullString
 For k = 1 To 8
   If Cells(i, 1).Offset(0, k) <> 0 Then
     Cells(m, "k").Resize(, 9).Value = Cells(i, 1).Resize(, 9).Value
     m = m + 1
    Exit For
   End If
   Next
   i = i + 1
  Loop
End Sub

 

 

 

 

[Alsalim1]

مثال مرفق فيه 11 عمود 

 

 

 

August Payroll.rar

[Alsalim1]

شباب ما زلت أنتظر ردكم 

 

 

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

يا اخي ارفع ملفاً يستطيع الانسان ان يفهم منه شيئاً

مثلاً عندك جدول من صفين و كل اعمدته ابتداء من العامود الثالث تساوي صفر او فراغ

ماذا تريدنا ان نعمل

الرجاء رفع ملف جديد فيه بعض البيانات (10  15 سطر) مع شرح ما تريد  و وضع جدول ( ثاني ) بالنتائج المتوقعة

[Alsalim1]

شباب ما زلت أنتظر ردكم 

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

يا اخي ارفع ملفاً يستطيع الانسان ان يفهم منه شيئاً

مثلاً عندك جدول من صفين و كل اعمدته ابتداء من العامود الثالث تساوي صفر او فراغ

ماذا تريدنا ان نعمل

الرجاء رفع ملف جديد فيه بعض البيانات (10  15 سطر) مع شرح ما تريد  و وضع جدول ( ثاني ) بالنتائج المتوقعة

 

استاذ طلبي من البداية واضح وأنت ما قصرت عملت الكود والكود جداً شغال بس في ورقة العمل التي تكون فيها أكثر من 10 أعمدة الكود لا يعمل ما ادري ما هي المشكلة في الملف المرفق أريد يعطيني بيانات الموظفين الذين حصل تغيير في مرتباتهم في المثال المرفق أحمد وعبدالله حصل تغيير في رواتبهم اريد الكود يظهر لي بيانات أحمد  وعبدالله في العمود M ولا يظهر لي بيانات علي لان ما حصل تغيير في مرتبه

 

 

August Payroll.rar