الـعيدروس

السلام عليكم جزاك الله خير اخي قنديل صوت جميل وهذا ملف الاخ قنديل مع تشغيل تلقائي عند فتح الملف http://www.4shared.com/rar/25LdoUdO/__online.html

all لصق معادلات او تنسيقات الخليه المصدر

السلام عليكم وهذا كود اخر الى حل العلامه خبور خير Private Sub CommandButton1_Click() For Each Tn In Controls If TypeOf Tn Is MSForms.TextBox _ And Not IsEmpty(Tn) Then Lr = [A1000].End(xlUp).Row + 1 Cells(Lr, 1) = CStr(Tn) End If Next End Sub

السلام عليكم بارك الله فيك اخي تومي محمد وعيدكم مبارك وكل سنه وانت باافضل حال ان شاء الله هذا الكود Public Sub Ali_Sm() Dim Vl# With ActiveDocument For Each R In .Tables(1).Range.Cells Vl = Vl + Val(R.Range.Text) Next .Tables(2).Cell(1, 1).Range.Text = Vl End With End Sub

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

السلام عليكم الصق المعادلة التاليه في خلية "H1" معادلة صفيف انقر "Ctrl" + "Shift" + "Enter" =SUM(1/COUNTIF(C2:C50;C2:C50))

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

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

تقصد بحيث تتغير الارقام في الاكسل مع تغير احداثيات التشارت في البرنامج الخارجي

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

ربط التشارت لماذا لا تأخذ البيانات من البرنامج الخارجي الى عمود معين وبعد لصق القيم تحدث تشارت جديد بكود في الاكسل ؟ وعند لصق قيم جديدة في العمود من البرنامج الخارجي يتحدث التشارت المنشاء مسبقاً

كشكول درر بارك الله فيك اخي نارت ( ابوادم ) تقبل مروري

السلام عليكم الاخ الفاضل ابراهيم محمد جزاك الله خيرا تقبل مروري

الاخ زمزم شكرا لك على المرور العطر تحياتي

الحمد لله

لاحظ بعض مرات مع تنفيذ الكود بتظهر لديك نتائج في ورقة المواد "بشكل تاريخ" للتغلب على المشكله استخدم التعديل التالي قبل نقل القيمة يقوم بتغيير تنسيق الخليه كي تكون النتائج كنص Public Sub Ali() Set Sh = Sheet4 With Sh [C7:Av50] = Empty: .[D4:Av50].Value = Application.Trim(.[D4:Av50].Value) For C = 4 To 50 For Each R In .Range("D" & C & ":AV" & C) If R <> "" And R = [I2] Then With Cells(Rows.Count, R.Column - 1).End(xlUp) .Offset(1, 0) = R: .Offset(2, 0).NumberFormat = "@" .Offset(2, 0) = CStr(Sh.Cells(R.Row, 2)) End With End If Next Next End With End Sub

السلام عليكم خلية التاريخ "M11" خلية الوقت "N11" =CONCATENATE(TEXT(M11;"yyyy/mm/dd");" ";TEXT(N11;"[$-2000409]h:mm AM/PM;@"))

سلمت اخي حمادة عمر على مرورك الكريم

Public Sub Ali() With Sheet4 [C7:Av50] = Empty ' الغاء المسافات بين الشرط في ورقة كشاف .Range("D4:Av50").Value = Application.Trim(.Range("D4:Av50").Value) ' حلقة تكرارية بين اعمدة ايام الأسبوع عمود 4 : عمود 50 For C = 4 To 50 ' حلقة تكرارية بين صفوف اعمدة الايام For Each R In .Range("D" & C & ":AV" & C) 'I2 'شرط الا تكون الخليه فارغه وأن تساوي الشرط الذي في خلية If R <> "" And R = [I2] Then ' اخر صف به بيانات في اعمدة الايام + 1 صف Rr = Cells(Rows.Count, R.Column).End(xlUp).Offset(1, 0).Row ' Rr خلية اخر صف وعمود اليوم ' R.Value'لاستخراج الشرط Cells(Rr, R.Column - 1).Value = R.Value ' Rr + 1'اخر صف به بيانات +2 ' .Cells(R.Row, 2).Value' لاستخراج الشرط من عمود 2 في ورقة كشاف من الصف الذي يوافق الشرط Cells(Rr + 1, R.Column - 1).Value = .Cells(R.Row, 2).Value End If ' نهاية حلقة المدى Next ' نهاية حلقة الأعمدة Next End With End Sub

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

السلام عليكم جرب هكذا Public Sub Ali() With Sheet4 [C7:Av50] = Empty .Range("D4:Av50").Value = Application.Trim(.Range("D4:Av50").Value) For C = 4 To 50 For Each R In .Range("D" & C & ":AV" & C) If R <> "" And R = [I2] Then Rr = Cells(Rows.Count, R.Column).End(xlUp).Offset(1, 0).Row Cells(Rr, R.Column - 1).Value = R.Value Cells(Rr + 1, R.Column - 1).Value = .Cells(R.Row, 2).Value End If Next Next End With End Sub

السلام عليكم جرب هذا التعديل Sub Techers_List() Application.ScreenUpdating = False Dim X1 As Long, X As Long [C7:Av50] = Empty With Sheet4 .Range("D4:Av50").Value = Application.Trim(.Range("D4:Av50").Value) For J = 4 To 48 For i = 4 To 35 Step 2 If .Cells(i, J) <> "" Then If [I2] = .Cells(i, J).Value Then Cells(i + 1, J - 1) = .Cells(i, J) Cells(i + 2, J - 1) = .Cells(i, 2) End If End If Next i Next J End With End Sub

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

السلام عليكم Public Sub Ali_Tab() Dim Sht As Worksheet Dim Tb As ListObject Dim r_Tb As Range On Error Resume Next Nm = "my_Table" For Each Sht In ThisWorkbook.Worksheets With Sht M = Nm & ii Rw = Split(.UsedRange.Address, "$")(4) Cl = Split(.UsedRange.Address, "$")(3) Set R = .Range(.Cells(1, 1), Cl & Rw) Sht.ListObjects.Add(xlSrcRange, R, , xlYes).Name = M ii = ii + 1 End With Next Sht MsgBox "تم تحويل النطاقات الى جداول", vbInformation, "" On Error GoTo 0 End Sub تحياتي وودي

السلام عليكم الصق الدالة المعرفة التالية في مودويل Public Function Cont_Ali(ByVal A As Range, Cnd As String) As Integer Dim R As Range With A For Each R In .SpecialCells(xlCellTypeConstants).Rows If R.Value Like Cnd & "*" Then ii = ii + 1 End If Next If ii Then Cont_Ali = ii End With End Function الاستخدام في خلية "A3" =Cont_Ali(B6:B255;"حول") في الخلية "B3" =Cont_Ali(B6:B255;"حولت")