إلى محترفي الإكسل

[seaprince46]

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

إخواني الكرام هذه أول مشاركه لي في هذا المنتدى الذي هو بالفعل أروع من رائع

وأنا شخصيا مبتديء في موضوع الفيجوال بيسك التطبيقية

وعندي سؤال حيرني وأرجو أن أجد له إجابه هنا وأعتقد أنه سهل لكني أجهله لجهلي في التعامل مع هذا الموضوع

سؤالي هو

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

من غير الممكن التغيير في هيئه الملف

المطلوب البحث في العمود H

والسؤال عن القيمه الموجوده فيها هل هي أكبر أو أقل من رقم معين على سبيل المثال 950

وفي حاله أنها أكبر يقوم بطرح50 من القيمة وإذا كانت أقل يقوم بإضافة 50 على القيمة

وبعد الإنتهاء من العمود H

نقوم بنفس العملية على العمود I

وبعد الإنتهاء من عملية المقارنه نقوم بعمل ترتيب تصاعدي لجميع الصفوف بالإعتماد على العمود H

بحيث نقوم بنقل الصف كاملا

الملف على الرابط التالي

ملف الإكسل

أرجو أن أجد ضالتي عندكم في أقرب وقت ممكن

[محمد حجازي]

السلام عليكم ...

جرب الكود التالي:

Sub MySort()
Dim MyValue As Double
MyValue = Application.InputBox(prompt:="أدخل القيمة", Type:=1)
For Each MyCell In Worksheets("Master").Range("H9:I22")
  If MyCell.Value > MyValue Then
    MyCell.Value = MyCell.Value - 50
  Else
    MyCell.Value = MyCell.Value + 50
  End If
Next MyCell
Worksheets("Master").Range("H9:I22").Sort Key1:=Worksheets("Master").Range("H9"), Order1:=xlAscending, Header:=xlGuess
End Sub

الكود السابق يقوم بطرح 50 من قيمة الخلية في حال كون قيمتها أكبر من الرقم المحدد ، ويقوم بإضافة 50 إلى قيمة الخلية في حال كون قيمتها أصغر من أو تساوي الرقم المحدد.

[seaprince46]

أخي الكريم أسف على الإطاله

إنسى جميع ماسبق هنالك طلب جديد بعد إذنك وهو

في الحل السابق يتم تطبيق الدوران حتى الخلية رقم 22 حتى لو كانت فارغة وما اريده الان أن يطبق الدوران على الصفوف التي تحتوي بيانات فقط

يعني قد تكون 5 او 10 او 20 او 100 مثلا

ثانيا:

المطلوب الجديد

1-أن يقوم في البدايه بترتيب الصفوف تصاعديا بالإعتماد على العمود H

2-بأخذ أقل قيمة في العمود H ويطرح منها الرقم 6 ثم يقوم بطرح جميع عناصر العمود H من القيمة الناتجة من طرح أقل قيمة

العناصر بعد الترتيب التصاعدي

1500

1501

1502

1503

1504

1505

1506

1507

1508

1509

أقل قيمة هي 1500-6=1494

نقوم بطرح 1494 من جميع القيم فتصبح

1500-1494=6

1501-1494=7

1502-1494=8

1503-1494=9

1504-1494=10

1505-1494=11

1506-1494=12

1507-1494=13

1508-1494=14

1509-1494=15

جميع النتائج التي أقل أو تساوي 10 يتم تحويل جميع قيمها إلى 1494

يتم إعتماد 6

7

8

9

10

بعد ذلك يتم أخذ أقل قيمة من القيم المتبقية وهي 1505 وطرح منها الرقم 6 ----> 1506-6=1499

1505-1499=6

1506-1499=7

1507-1499=8

1508-1499=9

1509-1499=10

يتم أخذ جميع القيم التي نتائجها أقل أو تساوي 10 وتحويلها إلى 1499 وما خالف ذلك يتم تطبيق نفس القاعده عليه

بحيث بعد تطبيق القاعده على جميع البيانات تصبح كما يلي :

1494

1494

1494

1494

1494

1499

1499

1499

1499

1499

ويتم تنفيذ جميع ماسبق على العمود I وبعد الإنتهاء يتم ترتيب العمود H تصاعديا

أرجو أن يكون المطلوب واضحا

[محمد حجازي]

السلام عليكم ...

فقط أخبرني بالشرط الذي يجب أن يتوقف الدوران عنده ، هل يوجد شرط محدد لتوقف الدوران أم أن العملية مؤلفة من مرحلتين فقط؟

[seaprince46]

أخي الكريم يتوقف الدوران عندما تصبح جميع القيم بعد الطرح اقل او تساوي 10

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

[محمد حجازي]

السلام عليكم ...

جرب الكود التالي:

Sub MySort()
Dim MyValue As Double
Worksheets("Master").Range("Q10:Q22").Value = Worksheets("Master").Range("H10:H22").Value
Do
  MyValue = Application.WorksheetFunction.Min(Worksheets("Master").Range("Q10:Q22")) - 6
  For Each MyCell In Worksheets("Master").Range("H10:H22").Cells
   If Not MyCell.Value = "" And Not Worksheets("Master").Cells(MyCell.Row, 17) = "" Then
     If MyCell.Value - MyValue <= 10 Then
       MyCell.Value = MyValue
       Worksheets("Master").Cells(MyCell.Row, 17).ClearContents
     Else
       Worksheets("Master").Cells(MyCell.Row, 17) = MyCell.Value
     End If
   End If
  Next MyCell
Loop Until Application.WorksheetFunction.Count(Worksheets("Master").Range("Q10:Q22")) < 1
Worksheets("Master").Range("Q10:Q22").Value = Worksheets("Master").Range("I10:I22").Value
Do
  MyValue = Application.WorksheetFunction.Min(Worksheets("Master").Range("Q10:Q22")) - 6
  For Each MyCell In Worksheets("Master").Range("I10:I22").Cells
   If Not MyCell.Value = "" And Not Worksheets("Master").Cells(MyCell.Row, 17) = "" Then
     If MyCell.Value - MyValue <= 10 Then
       MyCell.Value = MyValue
       Worksheets("Master").Cells(MyCell.Row, 17).ClearContents
     Else
       Worksheets("Master").Cells(MyCell.Row, 17) = MyCell.Value
     End If
   End If
  Next MyCell
Loop Until Application.WorksheetFunction.Count(Worksheets("Master").Range("Q10:Q22")) < 1
Worksheets("Master").Range("B10:O22").Sort Key1:=Worksheets("Master").Range("H10"), Order1:=xlAscending, Header:=xlGuess
End Sub

الكود السابق يحتاج للعامود Q لتخزين بعض القيم ، ويمكنك إخفاء هذا العامود كما هو موضح في الملف المرفق.

تحياتي

ProE_Door_Schedule.zip

[seaprince46]

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

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

في البداية أود أن أشكرك على سعه صدرك وسرعة جوابك لسؤالي الخاص بملف الإكسل

وكما قلت لك في البداية أنا مبتديء في موضوع ال الفيجوال بيسط التطبيقية

وماشاءالله الكود الذي قمت أنت بكتابته رائع جدا وكان من الصعب علي إستيعابه لكن أنا الأن أقوم بدراسته لفهمه

لكن عندي طلب أخر وبصراحه حاولت ولم أنجح وأنا الأن اشعر بالخجل منك لكن لايوجد امامي غيرك الأن ليساعدني

فالموضوع مهم جدا بالنسبه لي في العمل

المطلوب :

1- في الأول كنا نقارن الموجود في العمود H & I ونقوم بتعديل بياناتها لكن الأن المطلوب هو المقارنه في العمود H وتعديل البيانات وتسجيلها في العمود J

ومقارنه العمود I وتسجيلها في العمود K

2-في الحل الأول كنت تقوم بالدوران حتى الخليه 22 لكن قد يكون هناك أكثر من 22 صف حاولت جعلها أكثر لكن كان الحل بطيء

3-كنت تقوم بتخزين بيانات مؤقتا في العمود Q لكن هذا العمود يحتوي أصلا على بيانات فهل من الممكن جعلها FD مثلا بدلا من Q

4- المقارنه تتم فقط إذا كان العمود v يحتوي أحد القيم التاليه :

1F

3F

1FG

3FG

1-2F

2-1F

3-4F

4-3F

1-2FG

2-1FG

3-4FG

4-3FG

1FDA

1-2FDA

2-1FDA

1FGC

3FGC

1FGH

3FGH

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

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

[محمد حجازي]

السلام عليكم ...

جرب التعديل التالي:

Sub MySort()
Dim MyValue As Double
Dim i As Long
MyCondition = Array("1 F", "3 F", "1 FG", "3 FG", "1-2F", "2-1F", "3-4F", "4-3F", "1-2FG", "2-1FG", "3-4FG", "4-3FG", "1 FDA", "1-2FDA", "2-1FDA", "1 FGC", "3 FGC", "1 FGH", "3 FGH")
Worksheets("Master").Range("FD10:FD22").ClearContents
Worksheets("Master").Range("FE10:FE22").ClearContents
For Each MyCell In Worksheets("Master").Range("V10:V22").Cells
   For i = 0 To UBound(MyCondition)
     If MyCell.Value = MyCondition(i) Then
       Worksheets("Master").Cells(MyCell.Row, 160).Value = Worksheets("Master").Cells(MyCell.Row, 8).Value
       Worksheets("Master").Cells(MyCell.Row, 161).Value = Worksheets("Master").Cells(MyCell.Row, 9).Value
       GoTo RYes
     End If
   Next i
RYes:
Next MyCell
Worksheets("Master").Range("J10:J22").Value = Worksheets("Master").Range("H10:H22").Value
Worksheets("Master").Range("K10:K22").Value = Worksheets("Master").Range("I10:I22").Value
Do
  MyValue = Application.WorksheetFunction.Min(Worksheets("Master").Range("FD10:FD22")) - 6
  For Each MyCell In Worksheets("Master").Range("J10:J22").Cells
   If Not MyCell.Value = "" And Not Worksheets("Master").Cells(MyCell.Row, 160) = "" Then
     If MyCell.Value - MyValue <= 10 Then
       Worksheets("Master").Cells(MyCell.Row, 10) = MyValue
       Worksheets("Master").Cells(MyCell.Row, 160).ClearContents
     Else
       Worksheets("Master").Cells(MyCell.Row, 160) = MyCell.Value
     End If
   End If
  Next MyCell
Loop Until Application.WorksheetFunction.Count(Worksheets("Master").Range("FD10:FD22")) < 1
Do
  MyValue = Application.WorksheetFunction.Min(Worksheets("Master").Range("FE10:FE22")) - 6
  For Each MyCell In Worksheets("Master").Range("K10:K22").Cells
   If Not MyCell.Value = "" And Not Worksheets("Master").Cells(MyCell.Row, 161) = "" Then
     If MyCell.Value - MyValue <= 10 Then
       Worksheets("Master").Cells(MyCell.Row, 11) = MyValue
       Worksheets("Master").Cells(MyCell.Row, 161).ClearContents
     Else
       Worksheets("Master").Cells(MyCell.Row, 161) = MyCell.Value
     End If
   End If
  Next MyCell
Loop Until Application.WorksheetFunction.Count(Worksheets("Master").Range("FE10:FE22")) < 1
Worksheets("Master").Range("B10:CF22").Sort Key1:=Worksheets("Master").Range("K10"), Order1:=xlAscending, Header:=xlGuess
End Sub

ولكن يجب الانتباه إلى أن الفرز في نهاية الحل يتم على أساس العامود K وذلك للمجال B10:CF22 ، للعلم فقط.

[seaprince46]

السلام عليكم مجددا أخي الكريم

جزاك الله الف الف خير عما صنعت يداك

بارك الله فيك وكل شيء حتى الأن يعمل تمام التمام

ودمت ذخرا لهذا المنتى الراااائع فعلا

[seaprince46]

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

أخي الكريم محمد حجازي

لقد قمت بتطبيق جميع ما قمت بحله والحمد لله كل شيء شغال تمام والحمد لله

وأنا عاجز بصراحه عن شكرك

ولكن عندي طلب أخر بعد إذنك وهذا المثال كاملا

http://www.magic-sol.com/Grouping.zip

والمطلوب هو :

1- عند جمع المتغيرات في العمود H & I وطباعه النتائج في العمود J & K يقوم البرنامج بطباعه نفس النتائج السابقه في العمود L & M على النحو التالي

على فرض أن قيمة العمود

J K

1500 500

1501 501

1502 502

فتصبح القيم على النحو التالي

L M

1450 400

1451 401

1452 402

القاعده هي

M = K - 100

L = J - 50

2- طباعه النتائج في العمود N & O على النحو التالي :

N O

1498 494

1499 495

1500 496

القاعده هي

O= K - 2

N = J - 6

3- ملىء الأعمده التاليه

BJ=(H-J)/2

BK=(I-K)/2

BL=(I-K)/2

خالص شكري وتقدريري مقدما لك أخي الكريم محمد

[محمد حجازي]

السلام عليكم ...

يمكنك عمل ذلك ببساطة بواسطة الصيغ !!!

جرب الصيغ و إذا كنت مصمماً على كود الفيجوال فأخبرني لأريك الإضافات التي يجب عليك عملها.

[seaprince46]

شكرا على سرعة ردك أخي الكريم محمد

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

البيانات الموجوده فيها ووضعها في عمود ثاني مع عمليه بسيطه مثلا نضيف

10 على كل قيمه

بهذه الطريق سوف افهم مبدأ التعامل مع الخلايا والأعمده وأستطيع حل الأمور

البسيطه التي سوف تواجهني في المستقبل

سلامي لك