عبدالله بشير عبدالله

وعليكم السلام ورحمة الله وبركاته
جرب الكود حيث قبل التنفيذ، يقوم بحذف أي دوائر سابقة
1الثالث.xlsb
 
 
 

وعليكم السلام ورحمة الله وبركاته
كل عام وانت بخير
 الصفحات كثيرة وهذا سيجعل اي كود يستغرق وقتا اطول لاستدعاء البيانات استغرق على جهازي حوالي 6 دقائق بمعدل ثانية واحدة لكل صفحة
فكرة الاكواد ؟ الكود الاول (اسعار الاسهم ) يتم تشغيله مرة واحدة فقط ويستغرق عدة دقائق بعدها يتم التعامل مع زر التحديت ويستغرق اقل من دقيقة واحدة
من خلال 3 مواقع ذكاء اصطناعي تحصلت على  افضل كود يقوم بالمهمة 
التجرية تمت على اكسل 2016 لانه ليس لدي 2010 واعتقد ان الكود يعمل علي 2010
زر التحديث / بعد استدعاء البيانات يقوم زر التحديث بمقارنة البيانات المستدعاة بالموقع واذا كان هناك تغير يقوم يالتحديث
قم بالتجربة واعلمنا بالنتائج
افضل الاكواد تحصلت عليها من موقع https://chat.deepseek.com/
us_stocks_arincen (1).xlsb
 
 

وعليكم السلام ورحمة الله وبركاته
بالنسبة للاوقات التي خارج الاوقات في  M&N لم تحدده وفي اي بصمة تسجل
تم ربط المعادلات حسب الاوقات في M&N
اكسل1.xlsm
 

حرب التعديل التالي
توزيع عدد الحصص (233) (1).xlsm

وعليكم السلام 
نعم اعلم ان هناك طلب ثاني وكان ردي السابق لطلبك الاول
اليك الملف وبه طلبك الثاني
Plateform19840019.xlsb

طريقة حفظ الملف
بعد وضع الكود في الملف قم باغلاق الملف ستاتى رسالة كما بالصورة  اخت
 
اختر حفظ  ستاتى رسالة اخرى كما بالصورة 

 
 
 اختر لا ستفتح واجهة كما بالصورة  

قم بالاختيار حسب الصف المحدد  ثم حفظ
casse 2026 .xlsb

السلام عليكم 
نعم المشكلة من حماية الشيتات
 اليك التعديل مع اظافة الترقيم التلقائي لرقم التسجيل
Plateform (1) .xlsb
 
 
 

اليك  التعديل
Plateform (1).xlsb
 
 

اليك التعديل 
Plateform.xlsb

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

وعليكم السلام ورحمة الله وبركاته
اليك التعديل المطلوب 
Horaire1.xlsb

اولا / الملف السابق به كودين كلاهما معاينة تم تعديل احدهما الى طباعة
ثانيا  :- للتطبيق على ملفك / احعل لغة الجهاز العربية وانسخ الكود المرفق وفي ملفك الاخر قم بالدخول إلى صفحة الفيجوال بيسك عن طريق التبويب Developer(المطور) ثم Visual Basic    ثم من قائمة Insert  اختر  Module  والصقه  به واربطه بزر في الصفحة المراد ترقيمها
ملاحطة/ الكود المرفق مهمته الطباعة مع الترقيم
ان اردت المعاينة مع الترقيم بدون طباعة غير  كلمة FALSE الى TRUE في الجملة   ws.PrintOut From:=i, To:=i, Preview:=False
Sub طباعة() Dim ws As Worksheet Dim totalPages As Long Dim i As Long Dim pageNum As Integer Set ws = ActiveSheet totalPages = (ws.HPageBreaks.Count + 1) * (ws.VPageBreaks.Count + 1) For i = 1 To totalPages pageNum = Application.WorksheetFunction.RoundUp(i / 2, 0) If i Mod 2 <> 0 Then ws.PageSetup.CenterFooter = "الصفحة " & Format(pageNum, "00") Else ws.PageSetup.CenterFooter = "تابع الصفحة " & Format(pageNum, "00") End If ws.PrintOut From:=i, To:=i, Preview:=False Next i End Sub  

وعليكم السلام ورحمة الله وبركاته .
ارى الحل في الغاء جميع معادلات الصفيف واالابقاء على الاسماء في النطاق AA16:AA  وبدل المعادلات كود في حدث الورقة
ملاحظة هامة 
اذا اردت نقل الكود الى ملف اخر به الكمبوبكس1 يجب اجراء بعض التعديلات على اعدادات الكمبوبكس1
افتح الكمبوبكس في وضع التصميم  ثم خصائص تم امسخ البيانات في الدائرة الحمراء كما في الصورة  كذلك قم بمسخ المعادلات 

تقبل الله صيامكم وطاعاتكم
حل مشكل القائمة المنسدلةباستخدام ComboBox1.xlsm

وعليكم السلام ورحمة الله وبركاته
الحل هو نقل الكود إلى موديول (Module) عادي وتخصيص زر  لتشغيله فقط عندما تضيف أوراق عمل جديدة
اليك التعديل بالمرفق
المصنف2.xlsm
 
 

جرب التعديل التالي 
 
لا ننس كتابة اسم الملف في الحلية A2
الكل (1) (2).xlsm
لا حرج ان اردت اي تعديل احر

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

وعليكم السلام ورحمة الله وبركاته
 اليك الملف وبه كود المعاينة
ملف الحجز.xlsb

التصفية في ورقة جديدة
1تصفية.xlsb

السلام عليكم
حسب ما فهمته من طلبك المعادلة التالية تلبى المطلوب 
ضع المعادلة في l2 ثم اسحبها الى اسفل
=IFERROR(VLOOKUP(K2; $O:$P; 2; FALSE); "")  

السلام عليكم ورحمة الله وبركاته
حل بالكود وان  اضفت مواد احرى عدل النطاق في الكود
Sub ProcessAndSumData() Dim wsB As Worksheet Set wsB = ThisWorkbook.Sheets("B") Application.ScreenUpdating = False With wsB .Range("B10:I12").ClearContents With .Range("B10:I10") .FormulaR1C1 = "=IFERROR(SUMPRODUCT((A!R3C1:R1828C1=R6C3) * (ISNUMBER(INDEX(A!R3:R1828,0,MATCH(R8C,A!R1,0)))) * (INDEX(A!R3:R1828,0,MATCH(R8C,A!R1,0))>=60)),""/"")" .Value = .Value End With With .Range("B11:I11") .FormulaR1C1 = "=IFNA(SUMPRODUCT((INDEX(A!R3:R1828,0,MATCH(R8C,A!R1,0))<60) * ISNUMBER(INDEX(A!R3:R1828,0,MATCH(R8C,A!R1,0))) * (A!R3C1:R1828C1=R6C3)),""/"")" .Value = .Value End With With .Range("B12:I12") .FormulaR1C1 = "=SUM(N(R[-2]C), N(R[-1]C))" .Value = .Value End With End With Application.ScreenUpdating = True End Sub لا تنس تفعيل الماكرو
aa2.xlsb
 

وعليكم السلام ورحمة الله وبركاته
حسب فهمى لطلبك انك تقصد بالعمود الثالت  العمود A 
يناء   عليه اليك معادلة صعها بداية من D2 ثم اسحبها لاسفل  او ضغها في عمود بداية من الصف2
=INDEX($B$2:$B$500;MATCH(A2; $C$2:$C$500; 0))  ارجو ان يكون في ردي ما يفيد
تحياتي

وعليكم السلام ورحمة الله وبركاته
جرب الملف واعلمنى بالنتيجة
ملف الحجز.xlsb

السلام عليكم ورحمة الله وبركاته\
الطلب الاول
  
ملف الحجز.xlsb
اذا تحقق طلبك في الملف المرفق احتر تمت الاجابة وافتح موضوع جديد بطلبك الاحر به شرح واضح للطلب  وستجد من يقدم المساعدة للحل  وانا منهم
تحياني
 
 

ربما  يكون احد الاسباب  وكما احبرتك في ردي الاحير باننى لست جازما وحصوصا ان الملف في مشاركتك الاولى يعمل لدي وكذلك حسب استاذتا  Foksh ان الملف يعمل لديه
وربما يكون مسار سطح المكتب هو السبب
تم تعديل الكود وسيطلب منك مكان حفظ الملف احتر اي مكان 
جرب واعلمنى بالنتائج
مرتب +عمولة السائقين (2).xlsm
 

نعم الامر هكذا واضح وقمت بحذف التعليق السابق لعدم اهميته بعد ارفاق ملفك الاخير وبه التوضيح
جرب الكود  
Sub تجميع() Dim ws As Worksheet Dim آخرصف As Long Dim c As Long, r As Long Dim صف_الاخراج As Long Set ws = ActiveSheet صف_الاخراج = 1 ws.Columns(16).ClearContents For c = 1 To 13 آخرصف = ws.Cells(ws.Rows.Count, c).End(xlUp).Row For r = 1 To آخرصف If ws.Cells(r, c).Value <> "" Then ws.Cells(صف_الاخراج, 16).Value = ws.Cells(r, c).Value صف_الاخراج = صف_الاخراج + 1 End If Next r Next c End Sub