Answers from أبوعيد - أوفيسنا

أبوعيد's post in مشكل تثبيت الحلايا لدى السحب للأسفل was marked as the answer يوليو 7

تفضل
مثال معدل.xlsx

أبوعيد's post in جمع دلاله الوان بكل عامود was marked as the answer مايو 7

جرب هذا
test1 ‫‬.xlsx

أبوعيد's post in هل يمكن اختصار الكود التالي ليصبح اخف was marked as the answer مايو 2

تفضل جرب هذا من الذكاء الاصطناع
==============
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

أبوعيد's post in رصد درجات was marked as the answer فبراير 28

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

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

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

أبوعيد's post in اضافة كلمة المرور واسم المستخدم was marked as the answer فبراير 10

تفضل
Horaire 2.xlsb

أبوعيد's post in كيفية إرسال تقارير المرتب عبر الواتساب was marked as the answer فبراير 10

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

أبوعيد's post in تلوين صف و الخلية التي بها نشاط was marked as the answer فبراير 4

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

تقبل تحياتي

أبوعيد's post in دروس في استخدام المصفوفات was marked as the answer يناير 31

الموقع : https://www.araby.ai/
شرح الموقع https://youtu.be/U4l2mnnh0ZY

الموقع : https://gemini.google.com/app?hl=ar
الموقع : https://chatgpt.com/
الموقع : https://chat.deepseek.com/
وعيرها كثيرررررررر

أبوعيد's post in تعديل واضافة على ورقة ترحيل البيانات من ورقة الورقة اخرى was marked as the answer يناير 30

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

أبوعيد's post in المساعدة فى دمج خانتين للمبلغ فى خانة واحدة was marked as the answer يناير 17

تفضل اختر ما يناسبك
دمج مبلغ1.xlsx

أبوعيد's post in استخلاص البيانات الموجودة فى خلية لخلايا أخرى was marked as the answer ديسمبر 4, 2025

تفضل جرب
مثال1.xlsx

أبوعيد's post in منع تكرار الصنف was marked as the answer أكتوبر 16, 2025

إذا تطابق اللون والوصف والمقاس سيتم ألغاء الإضافة
Private Sub CommandButton1_Click() Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Dim WS As Worksheet, rng As Range Dim lastRow As Long Set WS = Sheet1 If Me.TextBox4 = "" Then: Exit Sub '======= lastRow = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row For i = 2 To lastRow ' äÈÏÃ ãä ÇáÕÝ 2 assuming ÇáÕÝ ÇáÃæá ÚäÇæíä If WS.Cells(i, 2).Value = Me.TextBox1.Value _ And WS.Cells(i, 3).Value = Me.TextBox7.Value _ And WS.Cells(i, 4).Value = Me.TextBox2.Value _ Then MsgBox "ÇáÈíÇäÇÊ ÇáÊí ÊÍÇæá ÃÖÇÝÊåÇ ãæÌæÏÉ ãä ÞÈá", vbOKOnly, "ÈíÇäÇÊ ãßÑÑÉ" Exit Sub End If Next i '======= Set rng = WS.Range("a2100").End(xlUp).Offset(1, 0) rng.Offset(0, 0).Value = Me.TextBox4.Value rng.Offset(0, 1).Value = Me.TextBox1.Value rng.Offset(0, 3).Value = Me.TextBox2.Value rng.Offset(0, 5).Value = Me.TextBox3.Value rng.Offset(0, 6).Value = Me.TextBox5.Value rng.Offset(0, 7).Value = Me.TextBox6.Value rng.Offset(0, 2).Value = Me.TextBox7.Value For i = 1 To 7 Controls("textbox" & i).Text = Empty Next i Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic End Sub

أبوعيد's post in حساب عدد و كمية عناصر خلال فترة محددة was marked as the answer سبتمبر 13, 2025

المطلوب الأول هو من جنس المطلوب الثاني ولا داعي لتكرار الجداول
المعادلات المستخدمة هي من نوع الصفيف وليست معادلات عادية
تفضل
example1.xlsx

أبوعيد's post in كود اخذ معلومات من شيت أخر was marked as the answer أغسطس 9, 2025

السلام عليكم
هذه محاولة بحسب ما فهمت
حل1 : اختر أول سطر للبيانات من القائمة المنسدلة الزرقاء
حل2 : مباشرة بدون اختبار سيتم اختيار آخر سطر
تفضل
جديد1.xlsm

أبوعيد's post in جلب بيانات خلية من جدول ثاني was marked as the answer يوليو 26, 2025

جرب هذا الملف
maachat3.xlsm

أبوعيد's post in مطلوب كود استدعاء للغائبين بدلا من المعادلات التي تثقل الملف was marked as the answer يوليو 17, 2025

تفضل اضغط على زر استدعاء في البحث ولاحظ النتيجة
الغياب1.xls

أبوعيد's post in اكمال ملاحظة was marked as the answer يوليو 11, 2025

السلام عليكم
تم عمل بعض التغييرات في الملف حتى تمشي الأمور تمام التمام

تم فك الدمج في خلايا الاحتياط لأن معادلة الصفيف لا تقبل الخلايا المدموجة
فقط قم تبغيير الرقم في P1 ولاحظ النتيجة
ملاحظة : كل المعادلات من نوع الصفيف التي تبدأ بقوس وتنتهي بقوس
تفضل جرب الملف

_اكمال ملاحظة5.xlsx

أبوعيد's post in عمل مصادقة بالأكسيل من بيانات SAP was marked as the answer يوليو 7, 2025

تفضل جرب الملف
مصادقة 1.xlsx

أبوعيد's post in تعديل معادلة لاحتساب عدد الساعات وما يزيد يصبح مدور was marked as the answer فبراير 26, 2025

وعليكم السلام
تم تعديل المعادلة في العمود F
تعديل معادلة1.xlsm

أبوعيد's post in حساب عدد حالات المباني والزراعة لكل حالة was marked as the answer فبراير 15, 2025

استفسار1.xlsx

أبوعيد's post in معادلة IF was marked as the answer ديسمبر 26, 2024

وعليكم السلام
كل حاجة تمام التمام المعادلة شغالة في K2 , K3
الخلل موجود في الصفحة main في الخلية E2 لا يوجد تاريخ
ادخل على الصفحة والخلية واكتب اي تاريخ ستجد كل شيء تمام التمام
تحياتي

أبوعيد's post in تعداد التلاميذ حسب الميلاد والجنس was marked as the answer سبتمبر 24, 2024

وعليكم السلام
جرب هذا الحل
قوائم التلاميذ معدل.xlsm

أبوعيد's post in عمل تنبيهات بالايميل was marked as the answer سبتمبر 1, 2024

ساعرض عليك فيدوهات تشرح الطريقة ولكن يجب أن تشاهدها كلها حتى تختار أسهل طريقة تناسبك
أولا :
https://youtu.be/pA9ySmQ01iY?si=p9nXmux1nT8qBGgp
ثانيا :
https://youtu.be/sBBKTP1io_M?si=VmXjQmgihaoJqBBy
ثالثا :
https://youtu.be/lgbHqyDsfwg?si=oQzRCmGxXMVsNscA

أبوعيد's post in الاستعلام بالدوال was marked as the answer يوليو 12, 2024

دليل الترحيل في الصفحة 1 بالعمود A موجود 1 , 2
بينما دليل الترحيل في الصفحة2 بالعمودِA موجود 1 قثط وبعده 3 ولا يوجد الرقم 2
جرب امسح الرقم 3 في الصفحة 2 في دليل الترحيل واكتب الرقم 2 ولاحظ النتيجة

أبوعيد's post in الرجا المساعدة لاستخراج نتيجة الطلاب was marked as the answer مايو 19, 2024

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

نتيجة للتجربة1.xlsx

تسجيل الدخول

أبوعيد

Posts

تاريخ الانضمام

تاريخ اخر زياره

Days Won

Community Answers

تصفح الموقع

تصفح جديد الموقع

Support

Important Information