أبوعيد

https://www.officena.net/ib/topic/139246-عمل-مصادقة-بالأكسيل-من-بيانات-sap/#findComment-774215 أهلا بك أخي : الذكاء الاصطناعي جعل المبرمجين عاجزين على كتابة كود بالكامل ولكن أصبح شغلهم هو التعديل على الكود فقط الأكواد الطويلة ( مثل الكود الذي طلبت تعديله ) يحتاج وقت لكتابة وتصحيح الأخطاء أما الذكاء الاصطناعي فيكتبه في 1 دقيقة فقط تقريبا (وربما يستغرق أكثر من هذا الوقت إذا كان الكود طويلا ) هذا القسم ليس مخصصا لشرح الذكاء الاصطناعي ادخل على اليوتيوب وستجد مئات المقاطع تشرح ذلك ولكن انصحك أن تركز على واحد (فقط فقط فقط فقط فقط) من نماذج الذكاء الاصطناعي لأنك مبتدئ فإذا عرفت استخدام هذا النموذج فيمكنك بعد ذلك التنقل بين النماذج المختلفة تقبل تحياتي

تفضل جرب هذا من الذكاء الاصطناع ============== Sub sale_m_Optimized() Dim wsItemOut As Worksheet, wsPerform As Worksheet, wsAccMove As Worksheet Dim wsAccMoveD As Worksheet, wsItemMove As Worksheet Dim lastRow As Long, i As Long, nRows As Long Dim dataArr As Variant Dim performArr As Variant, accMoveDArr As Variant Dim itemMoveArr As Variant, accMoveArr As Variant Dim docType As String, isReturn As Boolean Dim performStart As Long, accMoveDStart As Long Dim itemMoveStart As Long, accMoveStart As Long On Error GoTo CleanUp ' ═══════════════════════════════════════ ' إيقاف كل ما يبطئ التنفيذ ' ═══════════════════════════════════════ Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual ' ═══════════════════════════════════════ ' تعريف الأوراق (مرة واحدة فقط) ' ═══════════════════════════════════════ Set wsItemOut = ThisWorkbook.Sheets("itemout") Set wsPerform = ThisWorkbook.Sheets("perform") Set wsAccMove = ThisWorkbook.Sheets("accmove") Set wsAccMoveD = ThisWorkbook.Sheets("AccMove D") Set wsItemMove = ThisWorkbook.Sheets("itemmove") ' ═══════════════════════════════════════ ' فك الحماية ' ═══════════════════════════════════════ wsPerform.Unprotect Password:="m" wsAccMove.Unprotect Password:="m" wsAccMoveD.Unprotect Password:="m" wsItemMove.Unprotect Password:="m" wsItemOut.Unprotect Password:="m" ' إيقاف الفلاتر On Error Resume Next wsPerform.Rows("4:4").AutoFilter wsAccMoveD.Rows("4:4").AutoFilter wsAccMove.Rows("3:3").AutoFilter wsItemMove.Rows("4:4").AutoFilter wsItemOut.Rows("7:7").AutoFilter On Error GoTo CleanUp ' ═══════════════════════════════════════ ' التحقق من البيانات الإلزامية ' ═══════════════════════════════════════ With wsItemOut If .Cells(2, 2) = "" Or .Cells(5, 2) = "" Or .Cells(8, 2) = "" Or .Cells(2, 5) = "" Then MsgBox "أكمل البيانات: نوع الحركة, كود العميل, كود الصنف, الإذن اليدوي" .Range("B8").Select GoTo CleanUp End If End With ' ═══════════════════════════════════════ ' قراءة القيم الثابتة مرة واحدة ' ═══════════════════════════════════════ docType = wsItemOut.Cells(2, 2).Value isReturn = (docType = "مردودات مبيعات") ' ═══════════════════════════════════════ ' حساب عدد صفوف البيانات ' ═══════════════════════════════════════ lastRow = wsItemOut.Cells(wsItemOut.Rows.Count, 2).End(xlUp).Row If lastRow < 8 Then GoTo CleanUp nRows = lastRow - 7 ' قراءة كل بيانات المصدر في مصفوفة واحدة (B8:M...) dataArr = wsItemOut.Range("B8:M" & lastRow).Value ' ═══════════════════════════════════════ ' حساب صف البداية في كل شيت (مرة واحدة) ' ═══════════════════════════════════════ performStart = wsPerform.Cells(wsPerform.Rows.Count, 1).End(xlUp).Row + 1 accMoveDStart = wsAccMoveD.Cells(wsAccMoveD.Rows.Count, 1).End(xlUp).Row + 1 itemMoveStart = wsItemMove.Cells(wsItemMove.Rows.Count, 1).End(xlUp).Row + 1 accMoveStart = wsAccMove.Cells(wsAccMove.Rows.Count, 1).End(xlUp).Row + 1 ' ═══════════════════════════════════════ ' تهيئة المصفوفات للشيتات الأربعة ' ═══════════════════════════════════════ ReDim performArr(1 To nRows, 1 To 21) ' B:V ReDim accMoveDArr(1 To nRows, 1 To 21) ' B:V ReDim itemMoveArr(1 To nRows, 1 To 14) ' B:O ReDim accMoveArr(1 To nRows, 1 To 19) ' B:T ' ═══════════════════════════════════════ ' حلقة واحدة فقط لملء المصفوفات الأربع ' ═══════════════════════════════════════ For i = 1 To nRows ' ═══ شيت perform (أعمدة B:V) ═══ performArr(i, 1) = wsItemOut.Cells(3, 2).Value ' B performArr(i, 2) = wsItemOut.Cells(4, 2).Value ' C performArr(i, 3) = wsItemOut.Cells(5, 2).Value ' D performArr(i, 4) = wsItemOut.Cells(6, 2).Value ' E performArr(i, 5) = wsItemOut.Cells(2, 5).Value ' F performArr(i, 6) = dataArr(i, 1) ' G (من B) performArr(i, 7) = dataArr(i, 2) ' H (من C) performArr(i, 😎 = dataArr(i, 3) ' I (من D) performArr(i, 9) = dataArr(i, 4) ' J (من E) ' K: الكمية (سالب إذا لم يكن مردود) If Not isReturn Then performArr(i, 10) = dataArr(i, 5) * -1 Else performArr(i, 10) = dataArr(i, 5) End If performArr(i, 11) = dataArr(i, 6) ' L (من G) performArr(i, 15) = "no" ' P performArr(i, 21) = docType ' V ' ═══ شيت AccMove D (أعمدة B:V) ═══ accMoveDArr(i, 1) = wsItemOut.Cells(3, 2).Value ' B accMoveDArr(i, 2) = wsItemOut.Cells(4, 2).Value ' C accMoveDArr(i, 3) = wsItemOut.Cells(5, 2).Value ' D accMoveDArr(i, 4) = wsItemOut.Cells(6, 2).Value ' E accMoveDArr(i, 5) = wsItemOut.Cells(2, 5).Value ' F accMoveDArr(i, 6) = dataArr(i, 1) ' G accMoveDArr(i, 7) = dataArr(i, 2) ' H accMoveDArr(i, 😎 = dataArr(i, 3) ' I accMoveDArr(i, 9) = dataArr(i, 4) ' J accMoveDArr(i, 10) = dataArr(i, 5) ' K accMoveDArr(i, 11) = dataArr(i, 6) ' L accMoveDArr(i, 15) = "no" ' P accMoveDArr(i, 21) = docType ' V ' ═══ شيت itemmove (أعمدة B:O) ═══ itemMoveArr(i, 1) = dataArr(i, 1) ' B itemMoveArr(i, 2) = dataArr(i, 2) ' C itemMoveArr(i, 3) = dataArr(i, 3) ' D itemMoveArr(i, 4) = dataArr(i, 4) ' E itemMoveArr(i, 5) = docType ' F itemMoveArr(i, 6) = wsItemOut.Cells(3, 2).Value ' G itemMoveArr(i, 7) = wsItemOut.Cells(2, 5).Value ' H ' I/J: نفس المنطق الأصلي (أعمدة مختلفة حسب نوع الحركة) If Not isReturn Then itemMoveArr(i, 9) = dataArr(i, 10) ' J (من K في المصدر) Else itemMoveArr(i, 😎 = dataArr(i, 10) ' I (من K في المصدر) End If itemMoveArr(i, 11) = wsItemOut.Cells(5, 2).Value ' L itemMoveArr(i, 12) = dataArr(i, 12) ' M (من M في المصدر) itemMoveArr(i, 14) = wsItemOut.Cells(4, 2).Value ' O ' ═══ شيت accmove (أعمدة B:T) ═══ accMoveArr(i, 1) = wsItemOut.Cells(5, 2).Value ' B accMoveArr(i, 2) = wsItemOut.Cells(6, 2).Value ' C accMoveArr(i, 4) = wsItemOut.Cells(3, 2).Value ' E accMoveArr(i, 5) = wsItemOut.Cells(2, 5).Value ' F accMoveArr(i, 6) = wsItemOut.Cells(4, 2).Value ' G ' H/I: نفس المنطق الأصلي If Not isReturn Then accMoveArr(i, 7) = wsItemOut.Cells(36, 8).Value ' H Else accMoveArr(i, 😎 = wsItemOut.Cells(36, 8).Value ' I End If accMoveArr(i, 10) = dataArr(i, 5) ' K accMoveArr(i, 11) = wsItemOut.Cells(34, 8).Value ' L accMoveArr(i, 13) = wsItemOut.Cells(35, 8).Value ' N accMoveArr(i, 15) = docType ' P accMoveArr(i, 18) = wsItemOut.Cells(5, 3).Value ' S Next i ' ═══════════════════════════════════════ ' كتابة المصفوفات دفعة واحدة (أسرع بـ 100 مرة) ' ═══════════════════════════════════════ wsPerform.Range("B" & performStart & ":V" & performStart + nRows - 1).Value = performArr wsAccMoveD.Range("B" & accMoveDStart & ":V" & accMoveDStart + nRows - 1).Value = accMoveDArr wsItemMove.Range("B" & itemMoveStart & ":O" & itemMoveStart + nRows - 1).Value = itemMoveArr wsAccMove.Range("B" & accMoveStart & ":T" & accMoveStart + nRows - 1).Value = accMoveArr ' ═══════════════════════════════════════ ' كتابة الصيغ دفعة واحدة لكل نطاق ' ═══════════════════════════════════════ ' --- perform --- With wsPerform .Range("A" & performStart & ":A" & performStart + nRows - 1).FormulaR1C1 = "=IF((R[-1]C)<>""م"",(R[-1]C)+1,1)" .Range("N" & performStart & ":N" & performStart + nRows - 1).FormulaR1C1 = "=(RC[-3]*RC[-2])" .Range("Z" & performStart & ":Z" & performStart + nRows - 1).FormulaR1C1 = "=IF(RC[-13]>0,RC[-13]*-1,RC[-15])" .Range("AA" & performStart & ":AA" & performStart + nRows - 1).FormulaR1C1 = "=IF(RC[-14]>0,(RC[-16]+RC[-14])/RC[-16],0)" .Range("AB" & performStart & ":AB" & performStart + nRows - 1).FormulaR1C1 = "=MONTH(RC[-25])" End With ' --- AccMove D --- With wsAccMoveD .Range("A" & accMoveDStart & ":A" & accMoveDStart + nRows - 1).FormulaR1C1 = "=ROW()-4" .Range("N" & accMoveDStart & ":N" & accMoveDStart + nRows - 1).FormulaR1C1 = "=(RC[-3]*RC[-2])" .Range("W" & accMoveDStart & ":W" & accMoveDStart + nRows - 1).FormulaR1C1 = "=IF(RC[-21]<>R[-1]C[-21],SUMIFS(C[-9],C[-21],RC[-21],C[-1],RC[-1]),0)" If isReturn Then .Range("Y" & accMoveDStart & ":Y" & accMoveDStart + nRows - 1).FormulaR1C1 = "=IF(OR(RC[-3]<>R[-1]C[-3],RC[-23]<>R[-1]C[-23]),SUMIFS(C[-11],C[-23],RC[-23],C[-3],RC[-3]),0)" Else .Range("X" & accMoveDStart & ":X" & accMoveDStart + nRows - 1).FormulaR1C1 = "=IF(OR(RC[-2]<>R[-1]C[-2],RC[-22]<>R[-1]C[-22]),SUMIFS(C[-10],C[-22],RC[-22],C[-2],RC[-2]),0)" End If .Range("Z" & accMoveDStart & ":Z" & accMoveDStart + nRows - 1).FormulaR1C1 = "=SUMIFS(R4C[-2]:RC[-2],R4C[-22]:RC[-22],RC[-22])-SUMIFS(R4C[-1]:RC[-1],R4C[-22]:RC[-22],RC[-22])" End With ' --- itemmove --- With wsItemMove .Range("A" & itemMoveStart & ":A" & itemMoveStart + nRows - 1).FormulaR1C1 = "=IF((R[-1]C)<>""م"",(R[-1]C)+1,1)" .Range("K" & itemMoveStart & ":K" & itemMoveStart + nRows - 1).FormulaR1C1 = "=SUMIFS(R5C[-2]:RC[-2],R5C[-9]:RC[-9],RC[-9])-SUMIFS(R5C[-1]:RC[-1],R5C[-9]:RC[-9],RC[-9])" End With ' --- accmove --- With wsAccMove .Range("A" & accMoveStart & ":A" & accMoveStart + nRows - 1).FormulaR1C1 = "=ROW()-3" .Range("J" & accMoveStart & ":J" & accMoveStart + nRows - 1).FormulaR1C1 = "=SUMIFS(R4C[-2]:RC[-2],R4C[-8]:RC[-8],RC[-8])-SUMIFS(R4C[-1]:RC[-1],R4C[-8]:RC[-8],RC[-8])" .Range("T" & accMoveStart & ":T" & accMoveStart + nRows - 1).FormulaR1C1 = "=MONTH(RC[-13])" End With ' ═══════════════════════════════════════ ' تصفية itemout ' ═══════════════════════════════════════ wsItemOut.Range("A7:H40").AutoFilter Field:=2, Criteria1:="<>" CleanUp: ' ═══════════════════════════════════════ ' إعادة الحماية والإعدادات (دائماً تنفذ) ' ═══════════════════════════════════════ On Error Resume Next wsPerform.Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True wsItemMove.Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True wsAccMove.Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True wsAccMoveD.Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True wsItemOut.Protect Password:="m", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic End Sub

وعليكم السلام ورحمة الله وبركاته المشكلة في الملف نفسه الأسباب المحتملة كود VBA تالف. UserForms أو Modules فيها مشكلة. انقطع حفظ الملف أثناء التعديل. والحل لا بد من فحص الملف نفسه من الداخل لمعرفة سبب المشكلة

ممكن وبكل سهولة هذا البرنامج يسهل عليك أدخال الدرجات والتاريخ كذلك الشرح يطول ولكن ثق تماما أنك بمجرد أن تفتحه وتثبت الماكرو وتستخدمه ستفهم البرنامج ثم بعد التجربة أذا أردت أي توضيح نحن في الخدمة محرر الأكواد مفتوح ويمكنك التعديل عليه كما تريد الطريقة : افتح ملفك الذي تريد الأدخال فيه ثم افتح هذا الملف ثم اضغط على إحدى الأيقونتين (الدرجات أو التاريخ) وعندما يفتح الفورم انتقل مباشرة إلى ملفك الذي تريد الأدخال فيه ستجد أن الفورم ينتقل إلى الملف الجديد تفضل إدخال الدرجات والتاريخ.xls

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

بحسب المثال الذي أرفقته 15000 خصم ممنوح ( لماذا لم تختار هذه القيمة ) 15000 خصم ممنوع ( أنت اخترت هذه القيمة ) لماذا 15000 دفعة أولى مقدمة ( لماذا لم تختار هذه القيمة) توجد ثلاثة فيم 15000 أنت اختر الثانية . لماذا ؟ ================ نفس الأمر مع المبلغ 5000 ظهرت 3 مرة , أنت لونت الأولى والثالثة لماذا لم تلون الأولى والثانية أو الثانية والثالثة ؟ ================ ربما أني لم أفهم طلبك فعذرا أخي

السلام عليكم ورخمة الله وبركاته أخي فهد من الأفضل أن يكون المدين والمدان مستند إلى قواعد المحاسبة المشهورة أنت الأن تريد مطابقة المبالغ في العمود B مع العمود C لا حظ الخلايا التي لونتها باللون الأصفر ( غير سليمة محاسبيا ) يوجد 2 قيمة في العمود C تساوي 1500 لماذا اخترت القيمة الثانية ولم تختر القيمة الأولى ؟ هل الكشف يرجع لزبون واحد أم عدة زبائن ؟

وعليكم السلام ورحمة الله وبركاته أهلا بك أخي أسمح لي أن أقول لك وبكل احترام وتواضع السبب هو : أنت كتبت في الكود وقة5 بدون راء والصحيح ورقة5 بحرف الراء

تفضل Horaire 2.xlsb

أخي بلال أنت فاهم شغلك تمام , ونحن غير فاهمين حتى نحل مشكلتك لابد أن نفهم شغلك لا بد نفهم خطوة خطوة أنت تقول : استاذ قم بتغيير الخلية A2 ورقة حجز توقيت وأنا اقول : أغير الخلية إلى ماذا , ماذا أكتب في الخلية ؟ أنت تقول : B2 في ورقة حجز التوقيت وأنا أقول : ماذا أكتب في الخلية ؟ لا توجد قوائم منسدلة , لا توجد تنبيه لكتابة اسم أو رقم أو ماذا ؟ اشرح طلبك بالتفصيل وستجد الحل إن شاء الله طلبك السابق كان كتابة اسم المستخدم في ورقة حجز توقيت أو حجز التوقيت حصل عندي لخبطة كلما كان الشرح مفصلا كلما كانت الإجابة سريعة أكمل الفراغ في هذه العبارة وسأفهم طلبك : أريد عند فتح البرنامج أن يظهر اسم المستخدم في ورقة .......... خلية ......... ويظهر اسم المستخدم كذلك في ورقة ......... خلية ........... تقبل تحياتي

السلام عليكم ورحمة الله ملفك فيه ورقتان (حجز التوقيت) و ( حجزتوقيت) متشابهتان باختلاف ال التعريف الخلية B3 في كليهما تحوي على نص ( رقم الضمان الاجتماعي ) ولا يمكن الكتابة على هذا النص ركز معي حتى تكون أجابتك دقيقة فالاكسل دقيق أيضا أرجو التوضيح

وعليكم السلام ورحمة الله وبركاته الطريقة حدّد كل الجدول (أو النطاق الكبير اللي تشتغل فيه). من القائمة: اختر (تنسيق شرطي) ثم (قاعدة جديدة) ثم (استخدام صيغة لتحديد الخلايا المراد تنسيقها) اكتب الصيغة التالية: =ROW()=CELL("row") اختر اللون اللي تحبّه. اضغط (موافق) الأن كلما تكتب في أي خلية في السطر اضغط السهم لليمين أو اليسار وواصل الكتابة ـ يعني لاتنزل سطر جديد ولكن تابع الكتابة في نفس السطر تقبل تحياتي

اهلا بك مرة أخرى أخي لا توجه سؤالك لشخص معين , المنتدى هنا مليئ بالكوادر ولكن ولكن !! كل بحسب شغله , ونلتمس العذر للجميع من الأفضل أن تكتب طلبك بدون توجيه نداء لشخص بعينه ============ دعنا الآن في حل مشكلتك ارفق الملف الذي تريد التعديل عليه هنا وحدد طلبك كالآتي : عندما ينحج المستخدم في كتابة اسم المستخدم وكلمة المرور بشكل صحيح يتم الدخول على الملف أريد أن يظهر اسم المستخدم في ورقة (حجز التوقيت ) في الخلية C3 (مثلا) ======== هذا هو طلب واحد فقط في كل مشاركة اكتب طلب واحد فقط عندما نحل هذه المشكلة تكتب موضوع جديد وتطرح طلبك الثاني وهكذا .... الخ كل مشاركة بطلب واحد فقط وفي نهاية المشاركة بعد تحقيق طلبك اضغط على زر الإجابة الصحيحة أنتظر منك أن ترفع الملف هنا الآن تقبل تحياتي

لا أعلم المشكلة الملف يعمل عندي بشكل ممتاز عند ظهور هذه الرسالة اضغط زر DEBUG سيتم تلوين السطر المشكل بلون اصفر ما هو السطر المشكل ؟

السلام عليكم أخي لا يوجد ورقة في ملفك اسمها ورقة2 على العمود لا بد من كتابة أسماء كل الشيتات في ورقة KEYS والتحكم بظهورها وأخفائها ملاحظة في ورقة KEYS لا تكتب أي بيانات في السطر الأول (السطر الرمادي) إلا أسماء الشيتات فقط جرب المرفق Horaire4.xlsb