أبومروان

وعليكم السلام ورحمه الله وبركاته اتفضل المعادله يمكنك استخدام اي معادله لعلها تفي بالغرض والمطلوب =AND($F$1<>""; ISNUMBER(SEARCH($F$1; $A2 & $B2 & $C2))) =IF(ISBLANK($F$1);0;SEARCH($F$1;$A2&$B2&$C2)) يمكنك البحث عن اكتر من عمود وعدل المعادله كيفما تشاء واليك طريقه اخري للبحث والتولين مع الكود بدل المعادلات اختر ما يصلح Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Dim cell As Range Dim searchText As String Dim lastRow As Long If Not Intersect(Target, Me.Range("F1")) Is Nothing Then Application.ScreenUpdating = False Application.EnableEvents = False Me.Range("A2:C1000").Interior.ColorIndex = xlNone searchText = Trim(Me.Range("F1").Value) If searchText = "" Then Application.EnableEvents = True Application.ScreenUpdating = True Exit Sub End If lastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row Set rng = Me.Range("A2:C" & lastRow) For Each cell In rng.Rows Dim combinedText As String combinedText = cell.Cells(1, 1).Value & cell.Cells(1, 2).Value & cell.Cells(1, 3).Value If InStr(1, combinedText, searchText, vbTextCompare) > 0 Then cell.Interior.Color = RGB(255, 255, 153) End If Next cell Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub نرجو ان يكون المطلوب البحث معادله .xlsx andالبحث معادله .xlsx الكود .xlsm

الشكر لله وحده

جزاك الله خيراً

وعليكم السلام ورحمه الله وبركاته اتفضل لعله المطلوب EX.xlsx =IFERROR(INDEX(صادر!$A$2:$A$1000; MATCH(0; COUNTIF($A$1:A1; صادر!$A$2:$A$1000); 0)); "")

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

وعليكم السلام ورحمة الله وبركاته علي ما اعتقد الكود يعمل ولكن يجب اولا فك الحمايه عن الشيتات اثتاء العمل

السلام عليكم ورحمه الله وبركاته يمكنك مراجعه الربط ادناه لعله يفيد حضرنك تحويل الاكسل الى ملف تنفيذي (EXE) هل يمكن تغير شكل ايقونة التشغيل

وعليكم السلام ورحمه الله وبركاته جرب الكود التالي لعله المطلوب Private Sub CommandButton1_Click() ff = 7 Do Until Feuil1.Cells(ff, "a").Value = "" ff = ff + 1 Loop ' تحويل القيم إلى أرقام قبل التخزين Feuil1.Cells(ff, 1).Value = Val(TextBox1.Text) Feuil1.Cells(ff, 2).Value = CDbl(TextBox2.Text) ' استخدام CDbl للأرقام الكبيرة Feuil1.Cells(ff, 3).Value = CDbl(TextBox3.Text) Feuil1.Cells(ff, 4).Value = CDbl(TextBox4.Text) ' تطبيق تنسيق الأرقام على الخلايا Feuil1.Cells(ff, 2).NumberFormat = "#,##0.00" Feuil1.Cells(ff, 3).NumberFormat = "#,##0" Feuil1.Cells(ff, 4).NumberFormat = "#,##0.00" MsgBox ("تم التسجيل") Me.TextBox1.SetFocus Me.TextBox2.Text = "" Me.TextBox3.Text = "" Me.TextBox4.Text = "" ddd = 7 Do Until Feuil1.Cells(ddd, "a").Text = "" ddd = ddd + 1 Loop Me.TextBox1.Value = ddd + 1 - 7 End Sub Private Sub CommandButton4_Click() Feuil1.Activate ' تحويل القيم إلى أرقام عند التعديل ActiveCell.Offset(0, 0).Value = Val(TextBox5.Text) ActiveCell.Offset(0, 1).Value = CDbl(TextBox2.Text) ActiveCell.Offset(0, 2).Value = CDbl(TextBox3.Text) ActiveCell.Offset(0, 3).Value = CDbl(TextBox4.Text) ' تطبيق تنسيق الأرقام على الخلايا المعدلة ActiveCell.Offset(0, 1).NumberFormat = "#,##0.00" ActiveCell.Offset(0, 2).NumberFormat = "#,##0" ActiveCell.Offset(0, 3).NumberFormat = "#,##0.00" Me.TextBox5.Value = "" Me.TextBox2.Value = "" Me.TextBox3.Value = "" Me.TextBox4.Value = "" Me.TextBox5.SetFocus End Sub ' تعديل دوال التحويل في الأحداث Private Sub TextBox2_Change() If IsNumeric(TextBox2.Text) And IsNumeric(TextBox3.Text) Then Me.TextBox4.Value = CDbl(Me.TextBox2.Text) * CDbl(Me.TextBox3.Text) End If End Sub Private Sub TextBox3_Change() If IsNumeric(TextBox2.Text) And IsNumeric(TextBox3.Text) Then Me.TextBox4.Value = CDbl(Me.TextBox2.Text) * CDbl(Me.TextBox3.Text) End If End Sub

وعليكم السلام ورحمة الله وبركاته جزاك الله خيرا وعمل اكثر من رائع

واليك طريقه اخري بالكود Private Sub Worksheet_Change(ByVal Target As Range) Dim ws1 As Worksheet, ws2 As Worksheet Dim rng1 As Range, rng2 As Range Dim cell As Range Dim newValue As String ' تأكد أن التغيير حدث في العمود A (العمود 1) If Target.Column <> 1 Then Exit Sub If Target.Cells.Count > 1 Then Exit Sub ' تجنب اللصق الجماعي If IsEmpty(Target) Then Exit Sub Application.EnableEvents = False ' لمنع تشغيل الحدث مرارًا newValue = CStr(Target.Value) ' تحديد الأوراق Set ws1 = ThisWorkbook.Sheets("Sheet1") Set ws2 = ThisWorkbook.Sheets("Sheet2") ' تحديد النطاقات (نأخذ من A2 إلى آخر خلية غير فارغة) Set rng1 = ws1.Range("A2:A" & ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row) Set rng2 = ws2.Range("A2:A" & ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row) ' التحقق من التكرار في ورقة1 (باستثناء الخلية الحالية) For Each cell In rng1 If cell.Address <> Target.Address And cell.Value = newValue Then MsgBox "القيمة '" & newValue & "' موجودة مسبقًا في " & ws1.Name & "!", vbExclamation Target.ClearContents GoTo Cleanup End If Next cell ' التحقق من التكرار في ورقة2 For Each cell In rng2 If cell.Value = newValue Then MsgBox "القيمة '" & newValue & "' موجودة مسبقًا في " & ws2.Name & "!", vbExclamation Target.ClearContents GoTo Cleanup End If Next cell Cleanup: Application.EnableEvents = True End Sub طريقه اخري ب الكود.xlsm

وعليكم السلام ورحمه الله وبركاته جرب هذه الطريقه بالمعادلات اصنع نطاق وليكن من a1:a100 باسم AllNames حدد العمود الذي تريد منع التكرار فيه مثلاً: A2:A1000 — لا تشمل الخلية A1 إذا كانت عنوانًا اذهب إلى Data ← Data Validation. Allow: Custom Formula اكتب كرر نفس الكلام علي الشيت 2 =COUNTIF(AllNames, A2)=1 عدم التكرار بالمعادلات.xlsx

لحضرتكم بعض الارقام للعمل لوحه المفاتيح مفاتيح الأسهم KeyCode = 37 ' السهم لليسار ← KeyCode = 38 ' السهم للأعلى ↑ KeyCode = 39 ' السهم لليمين → KeyCode = 40 ' السهم للأسفل ↓ مفاتيح الوظائف KeyCode = 112 ' F1 KeyCode = 113 ' F2 KeyCode = 114 ' F3 KeyCode = 115 ' F4 KeyCode = 116 ' F5 KeyCode = 117 ' F6 KeyCode = 118 ' F7 KeyCode = 119 ' F8 KeyCode = 120 ' F9 KeyCode = 121 ' F10 KeyCode = 122 ' F11 KeyCode = 123 ' F12 مفاتيح التحكم KeyCode = 27 ' ESC KeyCode = 13 ' Enter KeyCode = 32 ' Space KeyCode = 9 ' Tab KeyCode = 8 ' Backspace KeyCode = 46 ' Delete KeyCode = 36 ' Home KeyCode = 35 ' End KeyCode = 33 ' Page Up KeyCode = 34 ' Page Down KeyCode = 45 ' Insert مفاتيح الأرقام KeyCode = 48 ' 0 KeyCode = 49 ' 1 KeyCode = 50 ' 2 KeyCode = 51 ' 3 KeyCode = 52 ' 4 KeyCode = 53 ' 5 KeyCode = 54 ' 6 KeyCode = 55 ' 7 KeyCode = 56 ' 8 KeyCode = 57 ' 9

وعليكم السلام ورحمه الله جرب الكود التالي لعله يفي بالغرض Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 27 Then ' 27 is the key code for Escape Unload Me End If End Sub Book1.xlsm

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

السلام عليكم ورحمه الله وبركاته ممكن تسنخدم الكود التالي قد يفي بالغرض Function MyFilter(LookInRange As Range, CriteriaRange As Range, CriteriaValue As Variant) As Variant Dim cell As Range Dim results() As Variant Dim count As Long Dim i As Long ReDim results(1 To CriteriaRange.Rows.Count, 1 To 1) count = 0 For i = 1 To CriteriaRange.Rows.Count If CriteriaRange.Cells(i, 1).Value = CriteriaValue Then count = count + 1 results(count, 1) = LookInRange.Cells(i, 1).Value End If Next i If count = 0 Then MyFilter = CVErr(xlErrNA) Else ReDim Preserve results(1 To count, 1 To 1) MyFilter = results End If End Function =MyFilter(A2:A10, B2:B10, "الرياض") A2:A10 العمود الذي تريد إرجاع القيم منه (مثل الأسماء) B2:B10 العمود الذي يحتوي على الشرط (مثل المدينة) "الرياض" القيمة التي يتم التصفية بناءً عليها

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

السلام عليكم ورحمه الله وبركاته شاهد الموضوع ادناه لعله يكون المطلوب تجميع و دمج عده ملفات عمل اكسيل في ملف عمل واحد - منتدى الاكسيل Excel - أوفيسنا

جزاك الله خيرا علي المجهود الرائع

السلام عليكم ورحمه الله وبركاته اتفضل لعله المطلوب Book1.xlsm

السلام عليكم ورحمه الله وبركاته ممكن تستخدم الكود التالي عند ظهور الاخطاء الخاصه من 32 الي 64 Private Declare Function استبدلها الي Private Declare PtrSafe Function ----------------------------------------------------------------- Private Declare استبدلها الي Private Declare PtrSafe

إللهم أذهب البأس ربّ النّاس، اشف وأنت الشّافي، لا شفاء إلا شفاؤك، شفاءً لا يغادر سقماً، أذهب البأس ربّ النّاس، بيدك الشّفاء، لا كاشف له إلّا أنت يارب العالمين

السلام عليكم ورحمه الله ارجو يكون المطلوب ترحيل.xlsx

وعليكم السلام ورحمه الله

وعليكم السلام ورحمه الله وبركاته من الواضح أنك تواجه مشكلة في فتح ملفات إكسل القديمة على جهازك، ولكن البرنامج يعمل بشكل طبيعي عند فتح مستندات جديدة أو عند تشغيله من قائمة "ابدأ". هذه المشكلة قد تكون ناتجة عن عدة أسباب. إليك بعض الحلول التي يمكن أن تساعدك في حل المشكلة: 1. إعادة تشغيل الكمبيوتر أول خطوة يجب أن تحاولها هي إعادة تشغيل جهاز الكمبيوتر. قد يكون هناك بعض العمليات التي تمنع إكسل من العمل بشكل صحيح. 2. تشغيل إكسل في الوضع الآمن قد تكون هناك مشكلة في الإضافات أو في إعدادات إكسل. جرب تشغيل إكسل في "الوضع الآمن" لحل هذه المشكلة. اضغط على مفتاح Ctrl باستمرار ثم افتح إكسل. إذا عمل إكسل بشكل طبيعي في الوضع الآمن، فالمشكلة قد تكون في إحدى الإضافات أو في ملف التكوين الخاص بالبرنامج. 3. إلغاء تثبيت التحديثات الأخيرة إذا كنت قد قمت بتثبيت تحديثات لأوفيس مؤخرًا، قد تكون هذه التحديثات قد تسببت في حدوث المشكلة. جرب إلغاء تثبيت آخر التحديثات: اذهب إلى إعدادات النظام في جهازك. اختر التطبيقات ثم ابحث عن Microsoft Office 2019. اختر إلغاء التثبيت أو إصلاح. 4. إصلاح أوفيس إذا كنت قد قمت بتثبيت أوفيس 2019 بنجاح، يمكنك محاولة إصلاح البرنامج عبر إعدادات أوفيس: افتح لوحة التحكم. اختر البرامج ثم البرامج والميزات. ابحث عن Microsoft Office 2019، واضغط عليه. اختر إصلاح ثم اختر الإصلاح السريع أو الإصلاح عبر الإنترنت. 5. تحقق من الأمان والحقوق تأكد من أن ملفات إكسل القديمة التي لا تفتح ليست محمية أو غير قابلة للوصول بسبب إعدادات الأمان على جهازك: تحقق من أن الملفات ليست قيد الحماية أو مملوكة لمستخدم آخر. تحقق من أن لديك صلاحيات كافية للوصول إليها. 6. تحديث إصدار إكسل أو أوفيس من الممكن أن المشكلة تتعلق بإصدار قديم من البرنامج. تأكد من أنك قد قمت بتحديث أوفيس إلى آخر إصدار: افتح أي برنامج من أوفيس (مثل إكسل). اذهب إلى ملف ثم حساب. اختر خيارات التحديث ثم تحديث الآن. 7. إزالة ذاكرة التخزين المؤقتة والملفات التالفة إذا كانت هناك ملفات تالفة قد تسبب المشكلة، حاول مسح الملفات المؤقتة الخاصة بأوفيس: اذهب إلى مستعرض الملفات ثم اكتب %appdata%\Microsoft\Excel في شريط العنوان. احذف أي ملفات تالفة أو غير ضرورية في هذا المجلد. 8. التحقق من التوافق إذا كانت الملفات التي لا تفتح قد تم إنشاؤها باستخدام إصدار قديم من إكسل، قد تكون هناك مشكلة في التوافق. جرب فتح الملف باستخدام إصدار آخر من إكسل أو استخدام الأدوات عبر الإنترنت مثل Excel Online لتحديد ما إذا كانت المشكلة في الملف نفسه. 9. إعادة تثبيت أوفيس إذا لم تنجح أي من الحلول السابقة، قد تحتاج إلى إعادة تثبيت أوفيس بشكل كامل: قم بإلغاء تثبيت Microsoft Office 2019 عبر لوحة التحكم. ثم أعد تثبيت الأوفيس من موقع مايكروسوفت الرسمي

السلام عليكم، هل يمكنك مراجعة المواضيع أدناه؟ قد تساعدك في المطلوب.