الـعيدروس

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

السلام عليكم ادخل رقم الوصل في الخلية الصفراء تفضل المرفق برنامج 1.rar

السلام عليكم الاخوة الاحبه ضاحي الغريب وشوقي ربيع عمل مميز وتمكن ملحوظ بارك الله فيكم تقبلو مروري

السلام عليكم حسب مافهمت اخ زمزم ان الخلايا التي تتلقى بيانات من مصدر خارجي تريد نسخها الى العمود التالي بشرط مره فقط في اليوم وبشرط مابين الساعه الرابعة عصرا فقط استخدمنا كود الاخ محمود الشريف مع بعض الاضافات اليك الكود غير المدى في اول الكود Private Const FD = "yyyy/mm/dd" Private Const FT = "hh:mm:ss" ' الخلايا التي تتلقى قيمها من مصدر خارجي Private Const Are As String = "$A$2:$A$500" Dim Tim_t Dim Dn As Range Dim Tn As Range Dim Tim Private Sub Ali_Tim() Set Tn = [XF1] Set Dn = [XG1] Tim_t = Now + TimeValue("00:00:05") Application.OnTime Tim_t, "Trn_Dt", , True Dx = IIf(Dn = "", Val(Date) - 1, Val(Dn)) If Time > TimeValue("16:00") And Time < TimeValue("16:59") Then If Dn = "" Then Tim_Cod ElseIf Dn = Date And Hour(Tn) = Hour(Tim) Then ElseIf Not Dx = Val(Date) Then Tim_Cod End If End If End Sub Private Sub Tim_Cod() Dim Rng As Range Set Tn = [XF1] Set Dn = [XG1] '================================ For Each Rng In Range(Are) If Rng > Empty Then With Rng Lc = Cells(.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Column Cells(.Row, Lc) = Rng End With End If Next '================================ Dn = Format(Now, FD) Tn = Format(Time, FT) Set Rng = Nothing Set Dn = Nothing: Set Tn = Nothing End Sub Private Sub Trn_Dt() Calculate Ali_Tim End Sub Sub auto_open() Ali_Tim End Sub Sub auto_close() On Error Resume Next Application.OnTime Tim_t, "Trn_Dt", , False End Sub

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

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

السلام عليكم اخي الكريم ان توفر الوقت سوف اعمل عليه ان شاء الله تحياتي

السلام عليكم حقيقة ارى الاستاذ احمد عبدالناصر فهم ماتريد وانجز الطلب على اكمل وجه بارك الله فيه ملاحظ حسب ماتوصلتو اليه ان الخلية التي بها Highest تعتبر ليس لها قيمة الـ Lowest والعكس برضه فكيف بيكون الطرح ؟

السلام عليكم شاهد المرفق Ct_Rn.rar

السلام عليكم استخدم المعادلة المركبة التاليه =Ls_Nm("1*") ============== =Ls_Nm("2*") الكود Function Ls_Nm(Sb$) As String For Each R In [C4:C30] If R.Text Like Sb Then V = CStr(R) Next Ls_Nm = V End Function

السلام عليكم جرب هذا الكود Public Sub Ali_Trn() With Sheet2 Dim Rng As Range, Lon As Range If [E2] = "" Then GoTo 1 Set Rng = .Range("A:A") Set Lon = Rng.Find(What:=[E2].Text, LookIn:=xlValues, LookAt:=xlPart) If Not Lon Is Nothing Then Set Rn = Lon.Resize(, 8) Ls = Rn.Cells(1, Rn.Columns.Count).End(xlToLeft).Column Lon.Offset(, Ls) = [E16] End If End With 1 End Sub

السلام عليكم جرب الكود التالي الصقه في حدث الفورم Private B_T, B_Lf Private Sub UserForm_Activate() B_T = Me.Top: B_Lf = Me.Left End Sub Private Sub UserForm_Layout() If Not IsEmpty(B_T) Then: Me.Top = B_T: Me.Left = B_Lf End Sub

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

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

السلام عليكم اذا الاوفيس الذي لديك 2007 ومافوق تم طرح الموضوع سابقا وتم الاجابه عليه رابط الموضوع http://www.officena.net/ib/index.php?showtopic=46533 وهذا المرفق الملف وبه الكود Scn_1.rar

السلام عليكم جرب الكود التالي Public Sub Ali_Smif() ' For ii = 2 To 199 Cells(ii, 2) = Sim_a(Range("A" & ii), [B1]) Cells(ii, 3) = Sim_a(Range("A" & ii), [C1]) Cells(ii, 4) = Sim_a(Range("A" & ii), [D1]) Cells(ii, 5) = Sim_a(Range("A" & ii), [E1]) Next ' End Sub Private Function Sim_a(ByVal A As Range, B1 As Range) On Error Resume Next Set Aa = ورقة2.[D1:D30000] Set Ab = ورقة2.[A1:A30000] Set Ad = ورقة2.[B1:B30000] Set Ag = ورقة2.[C1:C30000] Ch = "T" Sim_a = Application.SumIfs(Aa, Ab, B1, Ad, "<=" & A, Ag, Ch) On Error GoTo 0 End Function

السلام عليكم الاخ البروفسير الاخ مؤمن جمعة يرجاء فتح موضوع جديد للطلب

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

جزاك الله كل خير على هذا الدعاء ولك بالمثل اضعاف مضاعفه وفقك الله تقبل تحياتي وشكري

السلام عليكم جربت مرفق الاستاذ جمال عبدالسميع ويعمل لدي ربما المشكلة عندك فقط

السلام عليكم شاهد المرفق Ali_Key.rar

السلام عليكم جرب هذه المعادلة =CONCATENATE(TEXT(A5;"yyyy/mm/dd");" ";B5)

السلام عليكم الاخ الفاضل alshoi079 استخدم البحث في المنتدى يوجد برامج كثيره لطلبك تحياتي

السلام عليكم جزاك الله خير اخي ضاحي الغريب عمل مميز واكيد بيستفيد منه الكثير تم ارفاق ملف المشاركة 30# في المشاركة الأولى تقبل مروري

السلام عليكم جرب الكود التالي Public Sub Auto_open() Ali_Key End Sub Private Sub Ali_Key() Dim Ar As Variant Dim K_y As Variant Dim S_key As Variant On Error Resume Next For Each S_key In Array("+", "^", "+^%") Ar = Array("{BS}", "{BREAK}", "{CAPSLOCK}", "{CLEAR}", "{DEL}", _ "{DOWN}", "{END}", "{ENTER}", "~", "{ESC}", "{HELP}", "{HOME}", _ "{INSERT}", "{LEFT}", "{NUMLOCK}", "{PGDN}", "{PGUP}", _ "{RETURN}", "{RIGHT}", "{SCROLLLOCK}", "{TAB}", "{UP}", "x", _ "c", "a", "w", "f", "k", "g", "s", "t", "p", "v") For Each K_y In Ar Application.OnKey S_key & K_y, "" Next K_y Next On Error GoTo 0 End Sub