عبدالفتاح في بي اكسيل

لماذا لا تقوم فعل ذلك بزر واحد ؟ هل هذا ما تقصده؟ Private Sub CommandButton19_Click() TextBox6.Value=TextBox1.Value End Sub

عذرا اخي ولكن هذه طريقة غير لائقة تماما ماذا لوكان عندك 1000 عنصر في العمود الثاني كيف سيظهر في اليوزفورم؟!! يجب ان تكون ازرار محدودة . ربما شخص اخر لديه وجهة نظر افضل مني .

@M.NHAKAMI ولكن لماذا كل هذه الاسطر وعدم تنظيم في ارقام الليبل ؟! اقترح عليك بجعل ارقام الليبل بشكل متتالي حتى تسهل الامر عليك ومن تم وضعها في حلقة تكرارية ووضع الخلايا في مصفوفه على اي حال في نهاية مدى كل خليه ضع كلمة TEXT هذا مثال Label163.Caption = Sheets("دراسة فندق").Range("h6").Text

اعتقد انك مخطئ ، هذا يحدث عند الضغط على زر END

@الفارس محمد رجب عندما تتحدث عن خطأ يجب ان تظهر لنا في أي سطر والا الصورة لا معنى لها !

سأرى ما يمكنني فعله اذا لم يتدخل احد الأعضاء ولكن حاليا مشغول . تحياتي

لم افهم تعليقك الأخير ! هل عمل معك الملف ؟

@الفارس محمد رجب ولكن اين الكود الذي حاولت القيام به؟!! بالمناسبة موضوعك ليس بالمعقد ، يمكنك البحث عن مواضيع قد تم تناولها مسبقا وتعديله بناء على احتياجاتك. تحياتي

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

اذا كنت تقصد اظهار التقويم لاختيار التاريخ عندها يمكن استخدام اداتين date picker او calendar . هذه محاولة بعد القيام بإضافة فورم التقويم والقيام ببعض التعديلات . قم بالنقر مرتين علي خلية التاريخ وسيظهر التقويم . ولكن هذا يتوقف على اصدار الاوفيس اشك انها تعمل مع الإصدارات قبل 2016 واذا واجهتك مشكلة بإظهار رسالة بعدم وجود كائن عنده يجب تنصيبه حتى يظهر لك . حاليا يعمل معي باستخدام بإصدار 2019 تحياتي مطلوب تعديل.xlsm

جرب هذه المعادلة مع مراعاة الفاصلة على حسب اصدار الاوفيس =IF(ISERROR(SEARCH("-";F11));1;TRIM(RIGHT(SUBSTITUTE(F11;"-";REPT(" ";100));100)))

يجدر القيام بحلقة تكرارية في هذه الحالة Sub delete_tools() Dim ws As Worksheet For Each ws In Worksheets ws.DrawingObjects.Delete Next ws End Sub

عندما تريد المساعدة وجب ارفاق الملف ووضع البيانات قبل وكيف تكون بعد ، وما هو حجم بياناتك حتى يكون الكود بطيء ؟!! بنظرة على كودك يوجد حلقات تكرارية كثيرة وهذا الذي سيسبب البطيء . اختصر الحلقات التكرارية قدر الإمكان . تحياتي .

ادخل على خيارات الوظائف الاضافية وازل تاشيرات الادوات التي لا تريدها .

جرب هذ التعديل لا فائدة من السطر الاول في بداية الكود لقد قمت بازالته عند وضع احد الخلايا سيتم الفلترة وعند مسح الخلية سيتم عرض البيانات الكلية Private Sub Worksheet_Change(ByVal Target As Range) Dim LastRow As Long Dim FilterRange As Range LastRow = Me.Cells(Rows.Count, "D").End(xlUp).Row Set FilterRange = Range("C9:U" & LastRow) If Me.FilterMode Then Me.ShowAllData If Not IsEmpty(Range("D8")) Then FilterRange.AutoFilter Field:=2, Criteria1:=Range("D8").Value ElseIf Not IsEmpty(Range("E8")) Then FilterRange.AutoFilter Field:=4, Criteria1:=Range("E8").Value End If End Sub

@sabah2023 ,لكن كيف عمل معك الكود من البداية ؟!! طلبك يكون مثل هذا بناء على مشاركتك الاولى 2023/08/23 الكود لا يفعل ذلك ! عليك تغيير هذا السطر من .NumberFormat = "yyyy/dd/mm" الى .NumberFormat = "yyyy/mm/dd"

@AMIRBM لقد نظرت الى ملفك ولكن لا اجد اي معنى من استخدام الليست بوكس واظهار عمود واحد فقط !! اما ان تظهر كل الاعمدة بالليست بوكس ومن تم عند اختيار الصف من الليست بوكس يتم اظهارها بالتيكست بوكس او حدف الليست بوكس واستخدام التيكست بوكس بدلا من ذلك

ولكن في بعض الحالات لا تعمل عندما تكون بياناتك عبارة عن جدول وفي الكود يتم الاشارة الى مدى عادي لذا اجد من المفيد لتجنب المشاكل الاشارة الى كائن الجدول .

@mohamed.youssef ساعد نفسك قبل ان تطلب المساعدة من الاخرين الملف يجب ان يكون مفتوح بالكامل كيف سندخل لمحرر الاكواد وانت تخفي الورقة ما الفائدة من اظهار الرؤوس ، لما لا تقوم بعمل ليبل لكل راس وتنتهي المشكلة كما قمت بتصميم الفورم ؟ اذاكان كل اذن يحتوي على رقم فريد اذن ما الحاجة لاظهارة في التيكست بوكس طالما سيظهر فقط صف واحد بالليست بوكس؟ اذن البيانات واضحة ولا حاجة لذلك !

@2saad هل ممكن ان تقول لي المتغير i فيما يستخدم بناء على كودك؟!!! Private Sub CommandButton2_Click() Dim add As Integer i = Application.WorksheetFunction.CountA(Sheet54.Range("c:c")) add = Sheet54.Range("c1000").End(xlUp).row + 1 Sheet54.Cells(add, 3).Value = Me.TextBox1.Value Sheet54.Cells(add, 4).Value = Me.TextBox2.Value Sheet54.Cells(add, 5).Value = Me.TextBox3.Value Sheet54.Cells(add, 6).Value = Me.TextBox4.Value Sheet54.Cells(add, 7).Value = Me.TextBox5.Value Sheet54.Cells(add, 8).Value = Me.TextBox6.Value Sheet54.Cells(add, 9).Value = Me.TextBox7.Value Sheet54.Cells(add, 10).Value = Me.TextBox8.Value Sheet54.Cells(add, 11).Value = Me.TextBox9.Value Sheet54.Cells(add, 12).Value = Me.TextBox10.Value Me.TextBox1.Value = "" Me.TextBox2.Value = "" Me.TextBox3.Value = "" Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" Me.TextBox8.Value = "" Me.TextBox9.Value = "" Me.TextBox10.Value = "" MsgBox "تم حفظ البيانات بنجاح يا عم سعد", vbInformation, "تنبيه يا عم سعد" End Sub جرب هذا التغيير ولكن قبل كل شيء اتبع الخطوات بعناية 1- احدف اي صف فارغ في الجدول ( لا تجعل الجدول يحتوي على صفوف فارغة) 2- لا داعي للتيكست بوكس الخاص بالتسلسل لانه الكود سيقوم بادراج صف ويقوم بترقيمها اتوماتيكيا حينها سيصبح عند 9 تيكست بوكس وليس 10 كما في الكود 3- تم التعديل باضافة اجراءات خاصة بكائن الجدول هذه محاولة قد تفيدك Private Sub CommandButton2_Click() Dim tbl As ListObject Dim LastRow As Long Set tbl = Sheet54.ListObjects("Table14") LastRow = tbl.Range.Rows.Count With Sheet54 tbl.Range(LastRow, "B").Offset(1) = TextBox1.Value tbl.Range(LastRow, "C").Offset(1) = TextBox2.Value tbl.Range(LastRow, "D").Offset(1) = TextBox3.Value tbl.Range(LastRow, "E").Offset(1) = TextBox4.Value tbl.Range(LastRow, "F").Offset(1) = TextBox5.Value tbl.Range(LastRow, "G").Offset(1) = TextBox6.Value tbl.Range(LastRow, "H").Offset(1) = TextBox7.Value tbl.Range(LastRow, "I").Offset(1) = TextBox8.Value tbl.Range(LastRow, "J").Offset(1) = TextBox9.Value End With MsgBox "تم حفظ البيانات بنجاح يا عم سعد", vbInformation, "تنبيه يا عم سعد" Me.TextBox1.Value = "" Me.TextBox2.Value = "" Me.TextBox3.Value = "" Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" Me.TextBox8.Value = "" Me.TextBox9.Value = "" End Sub

@محمود الطحاوي مجرد فضول ان لم افهم ماذا تعني الصورة المدرجة وهل جربت اقتراحي ام لم تعرف التعديل . وعندما تتحدث عن خطا ما يجدر بك توضيح ماهو الخطا وفي اي سطر وماذا فعلت بالنموذج حتى ظهر الخطا لا احد يعمل على تخمين لاضاعة الوقت .

اذا اردت بالكود وجب عليك ارفاق ملف xlsm بناء على مرفقك وقلة التفاصيل لا تتوقع احد ان يجيبك . حتى تجد تفاعل اكثر ضع النتائج المتوقعة في الشيتات المستهدفة . عندما تكون الاكواد ضعيفة مع حجم بيانات كبيرة على الرغم من ان بياناتك قليلة جدا عندها استخدم الفلترة هذا مجرد تخمين واذاكان هناك شيء نسيته او شرحته بطريقة خاطئة وجب عليك تطويع الكود بنفسك . Sub CopyData() Application.ScreenUpdating = False Dim ws1 As Worksheet, ws2 As Worksheet Set ws1 = ThisWorkbook.Sheets("بيانات") Set ws2 = ThisWorkbook.Sheets("سجل قيد") Set ws3 = ThisWorkbook.Sheets("سجل حالات") With ws1 .Range("A1").AutoFilter 10, "" .AutoFilter.Range.Copy With ws2 .Range("A1").PasteSpecial xlPasteValues End With .Range("A1").AutoFilter End With With ws1 .Range("A1").AutoFilter 10, "<>" .AutoFilter.Range.Copy With ws3 .Range("A1").PasteSpecial xlPasteValues End With .Range("A1").AutoFilter End With Application.ScreenUpdating = True End Sub Book1.xlsm

مجرد تخمين Sub Button1_Click() Dim i As Long For i = Sheet1.Cells(Rows.Count, 3).End(xlUp).Row To 1 Step -1 If Sheet1.Cells(i, 3) = "ناجح" Or Sheet1.Cells(i, 3) = "راسب" Then Sheet1.Range("a" & i & ":c" & i).Copy Sheet3.Cells(Rows.Count, 1).End(xlUp).Offset(1) End If Next End Sub

@شبل ليث مجرد ملاحظة ملفك ثقيل به بيانات ضخمة ولا يتماشى مع الكود الذي لديك ، انت تظن انه لا يحدف شيء ولكن عليك الانتظار قليلا وستلاحظ انه حدف كما ان الكود لا يعتمد بتاتا على الليست بوكس فقط يقوم بمطابقة ما يظهر في التيكست بوكس مع العمود الثاني للشيت . تحياتي

مرحبا تريد رد ولا تريد ارفاق ملف 😱😱 ستتم الاجابة ايضا بلا ملف ومن واقع تخمين فقط يمكنك ازالة اخر سطر اذا كنت لا تريد مسح التيكست بوكس Private Sub TextBox1_Change() If Left(TextBox1.Text, 1) = "K" Then MsgBox "هذا الحرف موجود بالفعل" End If TextBox1.Text = "" End Sub