ابراهيم الحداد

السلام عليكم و رحمة الله استخدم هذا الكود Sub SumThig() Const str1 As String = "اجمالي العملاء", str2 As String = "اجمالي الموردين" Dim LR As Long, i As Long, x As Integer, y As Integer With Sheets("بيانات") LR = .Range("B" & Rows.Count).End(3).Row For i = 3 To LR If .Range("B" & i) = str1 Then x = i ElseIf .Range("B" & i) = str2 Then y = i End If Next .Range("E" & x) = WorksheetFunction.Sum(.Range("E3:E" & x - 1)) .Range("E" & y) = WorksheetFunction.Sum(.Range("E" & x + 1 & ":E" & y - 1)) End With End Sub

السلام عليكم و رخمة الله اخى الكريم / محمد حسن المحمد دائما ما يسعدنى مرورك الكريم و كلماتك العطرة تخيل اننى كنت سأحرم من هذه الصحبة الجميلة و الطيبة و المشاعر الرقيقة و عسى ان تكرهوا شيئا و هو خير لكم

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

السلام عليكم ورحمة الله ضف هذه الجزئية فى نهاية الكود For Each Ctrl In Me.Controls If TypeName(Ctrl) = "TextBox" Then Ctrl.Value = "" End If Next Ctrl

السلام عليكم ورحمة الله خصص زر فى الفورم و ضع به هذا الكود Private Sub CommandButton1_Click() arr = Array("B5", "C5", "F5", "C8", "E9", "G10") tmp = Array(TextBox1.Value, TextBox4.Value, TextBox3.Value, _ TextBox2.Value, TextBox5.Value, TextBox6.Value) For i = LBound(arr) To UBound(arr) Range(arr(i)) = tmp(i) Next End Sub

السلام عليكم ورحمة الله من تبويب Formula اختر Calculation Option ثم Automatic و ينتهى الامر

السلام عليكم ورحمة الله ضع هذه المعادلة فى الخلية B3 =IFERROR(INDEX(Department!$B$3:$B$415;SMALL(IF(Department!$E$3:$E$415=$A$1;ROW(Department!$E$3:$E$415));ROW(A1))-2);"") ثم اضغط CTRL+SHIT+ENTER ثم اسحب نزولا الى الخلية التى تريدها

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

السلام عليكم ورحمة الله اخى الكريم يبدو انك لم تفهم قصدى فانا لا استطيع ان اقرأ مايدور فى رأسك انا اريد فى الملف الخلايا بدأا من الخلية "I8" حتى الخلية "AL17" و الخاصة بالموطف نهى فتحى محمد الصغير ماهى النتائج التى تريد ان تظهر فيها لقد تركتها لى خالية و التنسق الشرطى لن يفيدنى فى شئ و انا لا استطيع العمل على الخيال و التخمين و هذا ما قصدته فى مشاركتى السابقة اتمنى ان تكون قد فهمت مقصدى هذا و الله ولى التوفيق

السلام عليكم ورحمة الله استخدم هذا الكود Sub DelCaps() Dim Wrd As String, Arr As Variant Dim i As Long, j As Long Wrd = Range("C2").Value Arr = Array("ر", "ا", "ل", "ط", "ح", _ "ن", "ق", "م", "س", "ك", "ه", "ي", "ع") For i = 1 To Len(Wrd) x = Mid(Wrd, i, 1) For j = LBound(Arr) To UBound(Arr) y = Arr(j) If x = y Then m = m & " " & x Range("C2") = m End If Next Next End Sub

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

السلام عليكم ورحمة الله لم تخبرنى بالنسبة ليوم الجمعة ما هو المطلوب ثانيا انا سحبت المعادلة حتى 30 صف اكمل انت و اسحبها حتى آخر صف

السلام عليكم ورحمة الله اخى الكريم المعادلة سليمة تماما اليك الملف بعد عمل تنسيق شرطى احرف "غ" لكى يظهر فى الخلايا التى تنطبق عليها الشروط التنسيق يشمل 30 صف فقط لضيق الوقت اليك الملف معادله1.xlsx

السلام عليكم ورحمة الله استبدل المعادلة السابقة بالمعادلة التالية =IF(AND(YEAR(I$7)=YEAR($H8);MONTH(I$7)=MONTH($H8);DAY(I$7)=DAY($H8));"غ";"ح")

السلام عليكم ورحمة الله ضع هذه المعادلة فى الخلية I8 ثم اسحب يسارا و لاسفل =IF(I$7=$H8;"غ";"ح") و اذا وجدت اى خلل فى نتائج المعادلة راجع تنسيق التواريخ فى العمودين و حاول توحيد التنسيق بينهما

السلام عليكم ورحمة الله ضع هذه العبارة On Error Resume Next قبل هذا السطر Sheets(ShNam).Range("C5").Resize(p, UBound(Temp, 2)).Value = Temp

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

السلام عليكم ورحمة الله اجعل المعادلة هكذا =VLOOKUP("*"&D7&"*";data!$B$3:$C$7;2;0)

السلام عليكم ورحمة الله استبدل هذه العبارة : If Arr(i, 2) = ShNam Or Arr(i, 5) = ShNam Then بهذه العبارة : If Arr(i, 2) = ShNam Or Arr(i, 4) = ShNam Or Arr(i, 5) = ShNam Then

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

السلام عليكم ورحمة الله استخدم هذا الكود Sub TrData() Dim Sh As Worksheet, ws As Worksheet Dim LR As Long, i As Long Dim ShNam As String, Arr As Variant Dim Temp As Variant, j As Long, p As Long Set Sh = Sheets("الحركة") LR = Sh.Range("D" & Rows.Count).End(3).Row Arr = Sh.Range("C5:K" & LR).Value ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For Each ws In Worksheets If ws.Name <> Sh.Name Then ShNam = ws.Name For i = 1 To UBound(Arr, 1) If Arr(i, 2) = ShNam Or Arr(i, 5) = ShNam Then p = p + 1 For j = 1 To 9 Temp(p, j) = Arr(i, j) Temp(p, 1) = p Next End If Next Sheets(ShNam).Range("C5").Resize(p, UBound(Temp, 2)).Value = Temp End If p = 0 Next End Sub

السلام عليكم ورحمة الله استخدم الكود التالى Sub TrData() Dim ws As Worksheet, Detl As Worksheet Dim LR As Long, p As Long, i As Long, C As Range Set ws = Sheets("قاعدة بيانات") Set Detl = Sheets("بيان") LR = Detl.Range("H" & Rows.Count).End(3).Row For Each C In ws.Range("E2:E" & ws.Range("E" & Rows.Count).End(3).Row) i = WorksheetFunction.CountIf(Detl.Range("H2:H" & LR), C) If i = 0 Then Detl.Range("H" & LR + 1).Offset(p).Resize(12) = C p = p + 12 End If Next End Sub

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

السلام عليكم ورحمة الله يجب تغيير تنسيق عمود الفصل الى Text

السلام عليكم ورحمة الله اذن لا مناص من استخدام الكود التالى Sub TrData() Dim ws As Worksheet, Sh As Worksheet Dim LR As Long, i As Long, j As Integer, p As Long Dim Arr As Variant, Tmp As Variant, Fsl As String Application.ScreenUpdating = False Set ws = Sheets("قوائم الفصول") Set Sh = Sheets("مجمع الشيتات") LR = Sh.Range("E" & Rows.Count).End(3).Row ws.Range("C" & ws.Range("E" & Rows.Count).End(3).Row + 1) = "" Fsl = ws.Range("F4").Value If IsEmpty(Fsl) Then Exit Sub Arr = Sh.Range("C10:P" & LR).Value ReDim Tmp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For i = 1 To UBound(Arr, 1) If Arr(i, 13) = Fsl Then p = p + 1 For j = 1 To 8 Tmp(p, j) = Arr(i, Choose(j, 1, 2, 3, 5, 7, 9, 10, 13)) Tmp(p, 1) = p Next End If Next If p > 0 Then ws.Range("C10").Resize(p, UBound(Tmp, 2)).Value = Tmp Application.ScreenUpdating = True End Sub