أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
هانى على ali mohamed ali-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة منع ادخال البيانات بعدة شروط اكسيل اسئله واجابات


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





تجميع العمود بعد آخر صف

السلام عليكم ورحمة الله وبركاته اريد من سيادتكم تجميع الأعمده I amp; H من الملف المرفق بعد ترحيل آخر صنف لآخر صف وهذا ه ..


موضوع مغلق

الصفحة 1 من 2 < 1 2 > الأخيرة »


14-09-2021 04:34 مساء
ashraf_hertlion
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 18-09-2017
رقم العضوية : 540
المشاركات : 260
الجنس : ذكر
تاريخ الميلاد : 7-11-1971
يتابعهم : 14
يتابعونه : 1
قوة السمعة : 329
 offline 

السلام عليكم ورحمة الله وبركاته
اريد من سيادتكم تجميع الأعمده I & H  من الملف المرفق بعد ترحيل آخر صنف لآخر صف
وهذا هو كود الترحيل المستخدم
Private Sub CommandButton1_Click()
Sheets("items_out").Activate
If TextBox1.Value <> "" And TextBox2.Value <> "" Then
lrow = WorksheetFunction.CountIf(Range("b6:b1000"), TextBox1.Value)
lrow = Range("a" & Rows.Count).End(xlUp).Row
Range("A" & lrow + 1).Value = "=ROW()-5"
Range("b" & lrow + 1).Offset(0, 0).Value = TextBox1.Value
Range("b" & lrow + 1).Offset(0, 1).Value = TextBox8.Value
Range("b" & lrow + 1).Offset(0, 6).Value = TextBox2.Value
Range("b" & lrow + 1).Offset(0, 4).Value = TextBox37.Value
Range("b" & lrow + 1).Offset(0, 5).Value = TextBox30.Value
Range("b" & lrow + 1).Offset(0, 7).Value = TextBox38.Value
Range("b" & lrow + 1).Offset(0, 8).Value = TextBox6.Value
Range("b" & lrow + 1).Offset(0, 2).Value = Format(TextBox7.Value, "yyyy/mm/dd")
Range("b" & lrow + 1).Offset(0, 3).Value = TextBox40.Value
Range("c4").Value = Format(TextBox7.Value, "yyyy/mm/dd  ddd")
Range("J4").Value = TextBox40.Value
End If
End Sub
أرجوا أن أكون قد اوضحت المطلوب ... شاكر جداً لحضارتكم على كل ما تقدموه لنا من معاونه ومساعادات
الموضوع مدموج من مواضيع متعدّدة
 
Combined:
 
 
 
  تجميع الأصناف.xls   تحميل xls مرات التحميل :(5)
الحجم :(44.032) KB



أفضل إجابة مقدمة من YasserKhalil وهي:
جرب الكود التالي عله يفيدك فيما تحاول الوصول إليه
Sub Test()
    Dim ws As Worksheet, lr As Long
    Set ws = ThisWorkbook.Worksheets("items_out")
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
    With ws.Range("A" & lr).Resize(1, 10)
        .Interior.Color = vbYellow
        .Borders.Value = 1
    End With
    ws.Range("C" & lr).Value = "الإجمالي"
    ws.Range("H" & lr).Resize(, 2).Formula = "=SUM(H6:H11)"
End Sub
عرض الإجابة




15-09-2021 03:47 صباحا
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10444
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36522
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif تجميع العمود بعد آخر صف
وعليكم السلام أخي الكريم أشرف
الملف المرفق لا يحتوي على الكود ولا الفورم الذي تعمل عليه. الرجاء إرفاق ملف معبر عن المطلوب مع وضع صورة لشكل النتائج المتوقعة وهل تريد عملية التجميع أن تتم في الفورم أم في ورقة العمل؟

15-09-2021 11:54 صباحا
مشاهدة مشاركة منفردة [2]
ashraf_hertlion
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 18-09-2017
رقم العضوية : 540
المشاركات : 260
الجنس : ذكر
تاريخ الميلاد : 7-11-1971
يتابعهم : 14
يتابعونه : 1
قوة السمعة : 329
 offline 
look/images/icons/i1.gif تجميع العمود بعد آخر صف
استاذنا الكبير / ياسر خليل
انا مقدر قيمة الوقت الذى تستقطعه من وقتك الثمين للرد على  مطالبنا وحل مشاكلنا ربنا ان شاء الله يجعله فى ميزان حسناتك الى يوم القيامة
مرفق مع الرد على الموضوع جزء من الملف الذى اعمل علية وصورة توضح الإجماليات المطلوب تنفيذها على العمودين I & H عند الطباعة بعد الترحيل من الفورم الى الشيت المسمى ( items_out ) انا اريد التجميع فقط على الشيت بعد ترحيل آخر صف كما هو موضح فى الصورة وليس التجميع على الفورم .
لك منى كل التحية والإحترام
 
  النتيجة المتوقعه عند الطباعه بعد الترحيل.jpg   تحميل jpg النتيجة المتوقعه عند الطباعه بعد الترحيل.jpg مرات التحميل :(0)
الحجم :(141.093) KB
 
  صرف أصناف للتشغيل - Copy.xlsm   تحميل xlsm مرات التحميل :(4)
الحجم :(66.766) KB


15-09-2021 03:33 مساء
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10444
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36522
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif تجميع العمود بعد آخر صف
جرب الكود التالي عله يفيدك فيما تحاول الوصول إليه
Sub Test()
    Dim ws As Worksheet, lr As Long
    Set ws = ThisWorkbook.Worksheets("items_out")
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
    With ws.Range("A" & lr).Resize(1, 10)
        .Interior.Color = vbYellow
        .Borders.Value = 1
    End With
    ws.Range("C" & lr).Value = "الإجمالي"
    ws.Range("H" & lr).Resize(, 2).Formula = "=SUM(H6:H11)"
End Sub

15-09-2021 09:10 مساء
مشاهدة مشاركة منفردة [4]
ashraf_hertlion
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 18-09-2017
رقم العضوية : 540
المشاركات : 260
الجنس : ذكر
تاريخ الميلاد : 7-11-1971
يتابعهم : 14
يتابعونه : 1
قوة السمعة : 329
 offline 
look/images/icons/i1.gif تجميع العمود بعد آخر صف
استاذى العزيز / ياسر خليل
من باب من لا يشكر الناس لا يشكر الله و انا اشكر حضرتك كتير لسرعة الرد وحسن الاستجابة واناشد سعة صدر حضرتك فيما يلى ...
فى الموضع ذاته اللى حضرتك تفضلت وكتبت كود ولا اروع من كده بس لما قمت بتجربته ظهرت لى بعض المشاكل منها
1- اريد أن اعرف أين اضع هذا الكود لكى يعمل تلقائى بعد آخر صف يتم ترحيله قبل الطباعة ولا اقوم بتفعيله كل مرة اريد الطباعه فيها .
2- عند التجربة ظهرت لى حالتان ومرفق لحضرتك صورتين لهاتين الحالتين .
3- حضرتك مقيد الكود بمدى معين يعنى بعد ادخال 6 صوف ويتم التجميع وفى حالة أكثر من ذلك لا يأخذ باقى الصفوف ضمن التجميع وأيضا فى حالة اقل من 6 صفوف يتم التجميع داخل معادلة التجميع ضمن المدى المحدد للكود من قبل وانا اريده ان لا يكون مقيد ومحدد بمدى معين ولكن اريده ان يكون المدى مطاطى على حسب عدد الصفوف سواء كانت كثيرة او كانت قليله .
برجاء من حضرتك النظر فى هذه الحالات وحلها وشكراً لحضرتك مقدما ... تقبل تحياتى

15-09-2021 09:18 مساء
مشاهدة مشاركة منفردة [5]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10444
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 535
قوة السمعة : 36522
عدد الإجابات: 254
 offline 
look/images/icons/i1.gif تجميع العمود بعد آخر صف
السلام عليكم أخي الكريم أشرف
يرجى مناقشة نقطة واحدة فقط لمحاولة التعرف على التفاصيل ، لأنه عندما كتبت الكود وفتحت الملف لم أجد كود للترحيل فقمت بعمل كود منفصل يوضع في موديول عادي على أساس أنك ستعرف فكرة الكود وتضيفه لكود الترحيل الموجود لديك
المنتدى من المفترض أن تتعلم منه وتضيف لنفسك وتحاول بنفسك حل المشاكل وإذا تعثرت طرحت المشكلة ، لا أن توضع الحلول الجاهزة بشكل دائم.
في انتظار مناقشة نقطة واحدة فقط مع وضع كافة التفاصيل والإشارة للكود المطلوب العمل عليه أو التعديل عليه.

15-09-2021 09:41 مساء
مشاهدة مشاركة منفردة [6]
ashraf_hertlion
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 18-09-2017
رقم العضوية : 540
المشاركات : 260
الجنس : ذكر
تاريخ الميلاد : 7-11-1971
يتابعهم : 14
يتابعونه : 1
قوة السمعة : 329
 offline 
look/images/icons/i1.gif تجميع العمود بعد آخر صف
استاذى المحترم/ ياسر خليل
سيادتك مقيد الكود بمدى معين  ws.Range("H" & lr).Resize(, 2).Formula = "=SUM(H6:H11)" يعنى بعد ادخال 6 صوف ويتم التجميع وفى حالة أكثر من ذلك لا يأخذ باقى الصفوف ضمن التجميع وأيضا فى حالة اقل من 6 صفوف يتم التجميع داخل معادلة التجميع ضمن المدى المحدد للكود من قبل وانا اريده ان لا يكون مقيد ومحدد بمدى معين ولكن اريده ان يكون المدى مطاطى على حسب عدد الصفوف سواء كانت كثيرة او كانت قليله .
كود الترحيل الموجود بزر الحفظ هو
ممنوع تكرار نفس المشاركات والا ستحذف جميع المشاركات
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Sheets("items_out").Activate
If TextBox1.Value <> "" And TextBox2.Value <> "" Then
lrow = WorksheetFunction.CountIf(Range("b6:b1000"), TextBox1.Value)
If lrow >= 1 Then
MsgBox ("عفواً هذا الكود تم إدخاله مسبقاً")
TextBox1.Value = ""
TextBox2.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
TextBox8.Value = ""
TextBox34.Value = ""
TextBox20.Value = ""
TextBox21.Value = ""
TextBox30.Value = ""
TextBox31.Value = ""
TextBox32.Value = ""
TextBox25.Value = ""
TextBox37.Value = ""
TextBox38.Value = ""
Else
lrow = Range("a" & Rows.Count).End(xlUp).Row
Range("A" & lrow + 1).Value = "=ROW()-5"
Range("b" & lrow + 1).Offset(0, 0).Value = TextBox1.Value
Range("b" & lrow + 1).Offset(0, 1).Value = TextBox8.Value
Range("b" & lrow + 1).Offset(0, 6).Value = TextBox2.Value
Range("b" & lrow + 1).Offset(0, 4).Value = TextBox37.Value
Range("b" & lrow + 1).Offset(0, 5).Value = TextBox30.Value
Range("b" & lrow + 1).Offset(0, 7).Value = TextBox38.Value
Range("b" & lrow + 1).Offset(0, 8).Value = TextBox6.Value
Range("b" & lrow + 1).Offset(0, 2).Value = Format(TextBox7.Value, "yyyy/mm/dd")
Range("b" & lrow + 1).Offset(0, 3).Value = TextBox40.Value
Range("c4").Value = Format(TextBox7.Value, "yyyy/mm/dd  ddd")
Range("J4").Value = TextBox40.Value
TextBox1.Value = ""
TextBox2.Value = ""
TextBox6.Value = ""
TextBox8.Value = ""
TextBox34.Value = ""
TextBox30.Value = ""
TextBox31.Value = ""
TextBox32.Value = ""
TextBox37.Value = ""
TextBox38.Value = ""
End If
Else
MsgBox ("عفواً البيانات غير موجوده برجاء كتابة البيانات")
End If
 Application.ScreenUpdating = True
TextBox1.SetFocus
End Sub


كود حضرتك لحل المشكلة هو
Sub Sum_Colom()
    Dim ws As Worksheet, lr As Long
    Set ws = ThisWorkbook.Worksheets("items_out")
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
    With ws.Range("A" & lr).Resize(1, 10)
        .Interior.Color = vbYellow
        .Borders.Value = 1
    End With
    ws.Range("C" & lr).Value = "الإجمالي"
    ws.Range("H" & lr).Resize(, 2).Formula = "=SUM(H6:H11)"
End Sub
 
 
  الحالة الثانية.jpg   تحميل jpg الحالة الثانية.jpg مرات التحميل :(1)
الحجم :(165.736) KB
  الحالة الأولى.jpg   تحميل jpg الحالة الأولى.jpg مرات التحميل :(0)
الحجم :(150.127) KB
 



الصفحة 1 من 2 < 1 2 > الأخيرة »


الكلمات الدلالية
العمود ، تجميع ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 06:05 صباحا