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

ايضا هذا كود اخر جميل وتعدد الخيارات بمجرد تشغيل تستطيع تحدد العمود الذي تريد من تحدف منه البيان وكذلك الكلمة او القيمة التي تريدها Sub DeleteRows() 'Updateby20140314 Dim rng As Range Dim InputRng As Range Dim DeleteRng As Range Dim DeleteStr As String xTitleId = "KutoolsforExcel" Set InputRng = Application.Selection Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8) DeleteStr = Application.InputBox("Delete Text", xTitleId, Type:=2) For Each rng In InputRng If rng.Value = DeleteStr Then If DeleteRng Is Nothing Then Set DeleteRng = rng Else Set DeleteRng = Application.Union(DeleteRng, rng) End If End If Next DeleteRng.EntireRow.Delete End Sub

جرب هذا الكود لعله يفي بالغرض Sub Test() Application.ScreenUpdating = False Dim i As Long Dim Lastrow As Long Lastrow = Cells(Rows.Count, "f").End(xlUp).Row For i = Lastrow To 1 Step -1 If Cells(i, "f").Value = "1/3" Or Cells(i, "f").Value = "2/3" Then Rows(i).Delete Next Application.ScreenUpdating = True End Sub

تفضل عدل تاريخ الكمبيوتر ومن ثم نشط الخلية b2 dt .xlsm

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

هل انت متاكدة اختي الكريمة من طريقة الحساب لان هذه الدوال لا تحسب بهذه الطريقة حيث تقوم بحساب الايام كلها خلال الفترة المحددة وبالتاي ستظهر 440 يوم و 14 شهر و سنة وعند ادخال التاريخ القديم مثلا: 01/01/2010 كيف نصبح في 16/03/2021 انت لم تدخلي الا سنة وشهرين و15 يوم المفروض في 2011 بصراحة لم افهم طريقة حسابك وهذه الدوال من المستحيل القيام بذلك

جربي هذ التعديل وانشاء الله سيعمل Private Sub CommandButton2_Click() n7 = (n6 + n5.Value) End Sub

جرب هذا بعد التعديل تواتي 15) fini (1).xlsm

ممكن توضيح اكثر هل تقصد حذف واذا كان لا من اي صف يبدا ؟!

اعدريني لقد اغفلت الاشهر والسنوات ولم اقم الا بالايام المفترض ان يعمل جربي هذا التعديل Private Sub CommandButton2_Click() n7 = DateAdd("d", n5.Text, n6) n7 = DateAdd("M", n4.Text, n6) n7 = DateAdd("YYYY", n3.Text, n6) End Sub

هذه محاولة ولكن يجب ان تتاكدي من عملية اضافة التاريخ الجديد لست متاكد اذا كانت تعمل بشكل جيد date of birth.xlsm

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

جرب هذه المعادلة =ROUNDUP(B8;0)

هذه محاولة لعله المطلوب warrenty.xlsm

تفضل اخي اسم الورقة غير صحيح لذلك يظهر الخطا تم معالجة الامر Nouveau Feuille de calcul Microsoft Excel - Copie.xlsm

اعتقد ان هذا ها تريده ترحيل.xlsm

تفضل Copy of Book12.xlsx

اخي الخطا الذي ظهرلي ليس كخطاك لقد قمت بمعالجته ويتم الترحيل عادي Nouveau Feuille de calcul Microsoft Excel - Copie.xlsm

بعد اذن الاستاد الرائد قد يساعدك هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range, dic As Object, rng As Range, chn As Range Dim sNms As Variant, a_b As String, i As Long Set chn = Intersect(Target, Range("C:C")) If Not Intersect(Target, Range("C:C")) Is Nothing Then Set rng = Range("C1", Range("C" & Rows.Count).End(3)) Set dic = CreateObject("Scripting.Dictionary") dic.comparemode = vbTextCompare rng.Font.Bold = True rng.Font.ColorIndex = xlAutomatic For Each c In rng sNms = Split(c, " ") a_b = "" If UBound(sNms) = 2 Or UBound(sNms) = 3 Then a_b = Trim(sNms(0) & " " & sNms(1) & " " & sNms(2)) If Not dic.exists(a_b) Then If UBound(sNms) = 3 Then dic(a_b) = c.Row End If Else c.Characters(1, Len(a_b)).Font.Color = vbRed Range("C" & dic(a_b)).Characters(1, Len(a_b)).Font.Color = vbRed End If End If Next c End If End Sub 11.xlsm

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

بصراحة اخي الموضوع ينقصه قليل من التفصيل لا ادري اذا كان هذا المطلوب قد تنفع هذه المعادلة =SUMPRODUCT(C3:C17;--(D3:D17=G3)) 1.xls

اخي الكريم كما قال الاخ احمد المشكلة من عندك قمت بتحميل الملف يعمل بكفاءة وانا اعمل عل اوفيس 2010 اصدار قديم

بعد اذن استاد سليم واثراء للموضوع Private Sub CommandButton1_Click() Dim i As Worksheet, myLoop As Long For Each i In Worksheets With i For myLoop = 2 To 104 If .Cells(myLoop, "j").Value = "سدد" Then .Rows(myLoop).Hidden = False Else .Rows(myLoop).Hidden = True End If Next myLoop End With Next i End Sub Private Sub CommandButton2_Click() Dim i As Worksheet, myLoop As Long For Each i In Worksheets With i For myLoop = 2 To 104 If .Cells(myLoop, "j").Value = "سدد" Then .Rows(myLoop).Hidden = True Else .Rows(myLoop).Hidden = False End If Next myLoop End With Next i End Sub اظهار واخفاء صفوف.xlsm

عند اكمال كتابة النطاق احرص ان يكون المؤشر في نهاية النطاق ثم اضغط f4

اخي الكريم تفضل هذا الملف شبيه الى حد ما لطلبك عليك الكتابة وسيتغير تلقائيا ولكن عليك دراسة الكود والتطبيق حتى يمكنك التغيير بناء على احتياجاتك color.xlsm

اين الملف على حد علمي هذا كود ترحيل والاختصار من اين تريده هل من بداية هذا السطر اما ماذا .Range("c" & lrow).Offset(0, 0).Value = TextBox1