طلب كود

[باسنت العمري]

السلام عليكم

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

كما في المرفق /

سالب.rar

[عادل حنفي]

السلام عليكم

الاخت الفاضلة

استفسار

Book1.rar

[طارق محمود]

السلام عليكم

الاخت افاضلة

أرجو ان يكون ماتريدين هو الذي بالورقة الثانية

تم إختيار خلايا السالب علي اساس اللون

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

ووضعت لكي كود آخر لحذف السالب من نفس الخلايا (إن إحتجتي)

تفضلي المرفق

سالب المجموع.rar

[باسنت العمري]

أخي aah-aah2008 شاكرة لك سرعة الرد والاستفسار فجزاك الله خيراً

أخي TareQ M هذا هو المطلوب فجزاك الله خيراً ،

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

سالب المجموع 2.rar

[طارق محمود]

السلام عليكم

الاخت افاضلة

تطبيق الكود يكون لمجموعة محدده مثلاَ مجموعة 1 من عمود A ، بعد فترة شهر مثلاً يتم تنفيذ الكود لمجموعة أخرى A4 ولا يشترط الترتيب في تنفيذ الكود حسب نهاية الرصيد يتم تنفيذ الكود

حبذا تنفيذ الكود دون الارتباط بلون الخلية ، إذا كان يصعب ذلك لامانع أن تكون الجداول أفقي

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

تم إختيار خلايا السالب علي اساسين لايجب تغيير أي منهما

(1) أن رقم المجموعة موجود بالعمود الأول

(2) أن عدد صفوف المجموعة(خلايا) = 5 صفوف الصف الرابع به سالب المجموع

أي أن الكود سيسأل عن رقم المجموعة المراد عمل سالب لها

ثم سيبحث في خلايا العمود A عن هذا الرقم ومن ثم يغير محتوي الخلية التي علي يساره للأسفل 3خلايا إلي سالب قيمة الخلية التي تعلوها

وإذا لم يجد رقم المجموعة في العمود A فلن يفعل شيئا ويخبر بأن الرقم غير موجود

تفضلي المرفق

سالب المجموع3.rar

[باسنت العمري]

أخي جزاك الله خير ،وجعل عملك في ميزان حسناتك.

هل نستطيع تنفيذ الكود على الجدول الأفقي كذلك ؟

واعذرني على الإطالة .

[طارق محمود]

السلام عليكم

نعم أختي

لكني لاأستطيع إرفاق ملفات من هذا الجهاز الآن

عموما هذا هو الكود ، حاولي نقله ووضع

زر لـــــ سالب المجموع الأفقي

وزر لــــ تفريغ سالب المجموع الأفقي

تفضلي الكود بالحالات كلها

Sub Saleeb()

Dim x As Integer

x = InputBox("Which Group you want?")

For i = 5 To 1000

If Cells(i, 1).Value = x Then Cells(i + 3, 2).Value = -Cells(i + 2, 2): Exit Sub

Next

MsgBox ("There's NO Group Number " & x)

End Sub


Sub NoSaleeb()

For i = 6 To 1000

If Cells(i, 1).Value > 0 Then Cells(i + 3, 2).ClearContents

Next

End Sub

Sub HzSaleeb()

Dim x As Integer

x = InputBox("Which HZ Group you want?")

y = [D1000].End(xlUp).Row ' Last Row


For i = 20 To y

If Cells(i, 4).Value = x Then Cells(i, 8).Value = -Cells(i, 7): Exit Sub

Next

MsgBox ("There's NO Group Number " & x)

End Sub

Sub NoHzSaleeb()

y = [H1000].End(xlUp).Row ' Last Row

If y < 20 Then y = 20

Range("H20:H" & y).ClearContents

End Sub

تم تعديل يونيو 22, 2011 بواسطه TareQ M

[طارق محمود]

مرفق الملف وبه الكود المعدل

سالب المجموع4.rar

[باسنت العمري]

أستاذي / جزاك الله خير واسعدك في الدارين .