توزيع قيم حسب الرقم المحدد

[mostafa albatrawy]

خوانى الاعزاء اتمنى المساعدة من خبراء الاكسيل

واتمنى ان تكون بالكود ان كان ذلك متاح حيث اننى قمت بعمل هذا الجدول المكون من القيمة و الرقم والارقام الموجودة ايضا من 1 الى 5 حيث اننى هنا عندما ادخل القيمة فى العمود الاول ثم الرقم فى العمود الثانى يتم وضع هذة القيمة فى الصف المقابل لهذا الرقم ولكن المشكلة هنا انة لا يجوز وضع اكثر من رقم واحد فقط وما اريد من الزملاء وخبراء الاكسيل هو

1 - عند وضع القيمة فى الصف الاول ثم وضع الرقم فى الصف الثانى يتم وضع هذة القيمة فى الصف المقابل لها ثم تفريغ نفس الصف حتى اقدر ان اضع قيمة اخرى فى نفس هذا الصف وقيمة اخرى ......الخ .

2 - لو امكن اعطاء رسالة ( هل تريد الحفظ ) قبل ان يتم تفريغ الصف حتى اكتب فى نفس الخلية مرة اخرى حتى يكون بامكانى وضع كل هذه القيم فى صف

واحد فقط وشكرا جزيلا لكم

test 22.RAR

[عبدالله المجرب]

وضح اكثر ما معنى جلب قيمة ثم مسحها!!!!

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

[mostafa albatrawy]

شكرا لك اخى عبدالله

ما اريدة ببساطة لو نظرت الى عمود القيمة سنجد اول قيمة هى 1000 وعمود الرقم ستجد اول رقم هو 1 اذا قمت انت بتغيير هذا الرقم من 1 الى 2 ستجد ال 1000 عند العمود الذى يسمى 2 واذا غيرت الى 3 ستجد ال 1000 عند العمود الذى يسمى 3 ............ هكذا ارجو التجربة

وما اريدة من حضرتك هو ان ادخل مثلا 1000 فى عمود القيم واكتب رقم 1 فى عمود الرقم يعطينى رسالة ( هل تريد الحفظ ) ( نعم او لا ) عند اختيار نعم يتم حفظ ال 1000 تحت العمود رقم 1 ثم يتم مسح ال 1000 وايضا رقم 1 ثم اكتب مرة اخرى فى نفس الخلية قيمة 2000 ولكن فى هذة المرة يكون الرقم 5 او 4 مثلا ويعطى رسالة ( هل تريد الحفظ ) ( نعم او لا ) ثم يحفظ فى العمود 4 او 5 حسب اختيارى .

كل ما اريدة هو وضع اكثر من قيمة فى صف واحد ولكن يكون ذلك عن طريق ( عمود القيمة وعمود الرقم ) وليس يدوى

ارجو ان تساعدنى واسف على الاطالة

وشكرا

[عبدالله المجرب]

السلام عليكم

جرب المرفق (اكتب القيمة ثم اختر الرقم وبعد الموافقة على النقل سيتم مسح القيمة والرقم فاذا اردت ان تنقل قيمة اخرى ادخل القيمة ثم اختر الرقم وهكذا)

test 22.RAR

[ابو اسامة العينبوسي]

السلام عليكم

ممكن اشارك اخى عبد الله بهذا الحل السريع

لضيق الوقت ان كان المطلوب نكمل

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 4 Then Exit Sub

Cells(Target.Row, Target.Cells.Offset(0, Target.Value).Column).Value = Target.Cells.Offset(0, -1).Value

End Sub

TEST 3.rar

[mostafa albatrawy]

اخوانى كم انا عاجز عن شكركم وزاد الله فى علمكم كى تعلموه الى غيركم شكرا جدا المثالين اروع من بعض وهو بالفعل ما اريدة .

هل لى ان اقوم بسؤال اخر يتعلق بنفس الموضوع لو سمحتوا لى .

السؤال الى حد ما اعم هو

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

الاول هو رقم المسلسل

و الثانى هو الشهر

مرفق لحضراتكم ومتشكر مرة اخرى واسف على الاطالة

test 5.RAR

[عبدالله المجرب]

ان شاء الله هذا الكود يفي بالغرض

Sub Abu_Ahmed()

Set ws = Sheets("SHEET!")

LR = ws.Range("d" & Rows.Count).End(xlUp).Row

For i = 4 To LR

sh = Cells(i, 4).Value

Sheets(sh).Cells(i, ws.Cells(i, 6).Value + 2).Value = ws.Cells(i, 5).Value

Next

End Sub

ضعه في زر أمر في الورقة SHEET!

[mostafa albatrawy]

اخى لقد قمت بمحاوله ولكن لم يتم عمل الكود ارجو منك المساعدة

[الحسامي]

السلام عليكم

لاثراء الموضوع

في المطلوب الاول يمكنك استخدام الكود التالي

Sub Abu_Ahmed()

Abdulla = MsgBox(" لقد طلبت ترحيل القيمة المحددة الى الموقع المحدد ومسح البيانات السابقة", _

vbYesNo + vbQuestion, "تحذير")

If Abdulla = vbYes Then ActiveCell.Offset(0, ActiveCell.Value).Value = ActiveCell.Cells.Offset(0, -1).Value

ActiveCell.Cells.Offset(0, -1).ClearContents

End Sub

او يمكنك استخدام الكود التالي في حدث التغيير

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 4 Then Exit Sub

Target.Offset(0, Target.Value).Value = Target.Cells.Offset(0, -1).Value

End Sub

في المطلوب الثاني يمكنك استخدام الكود التالي في حدث الدبل كليك بعد ادخال البيانات اضغط دبل كليك على اسم الشهر

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, [d4:d27]) Is Nothing Then

Dim Sht As Worksheet

For Each Sht In Application.Worksheets

If Sht.Name = Target.Value Then

Sht.Cells(Target.Row, Target.Offset(0, 2).Value + 2) = Target.Offset(0, 1).Value

Target.Offset(0, -1).Select

Exit Sub

End If

Next Sht

End If

End Sub

مرفق ملف

TEST 5.rar