رجب جاويش

وعليكم السلام ورحمة الله وبركاته أين تريد لصق بيانات التكست بوكس بعد نسخها

أخى الفاضل جرب هذا الكود Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Rng As Range, LR As Integer LR = Cells(Rows.Count, 2).End(xlUp).Row Set Rng = Range(Cells(1, 1), Cells(LR, 1)) Rng.Formula = "=IF(NOT(ISBLANK(B1)),COUNTA(B$1:B1),"""")" End Sub

هل تقصد هكذا ربط 2 كمبوبوكس.rar

السلام عليكم استخدم هذا الكود Private Sub Nawa_Change() Dim ii As Integer Dim sh As Worksheet Set sh = Sheets("تحديد القطاعات") If Nawa.Text = "" Then Me.TextBox_mycode = "" For ii = 6 To sh.Range("C" & Rows.Count).End(xlUp).Row If Sanf.Text = Cells(ii, 3) And Nawa.Text = Cells(ii, 4) Then Me.TextBox_mycode = Cells(ii, 5) Exit For End If Next End Sub ربط 2 كمبوبوكس.rar

أخى الفاضل استعمل هذه المعادلة =OFFSET(st!$A$2;;;COUNTA(st!$A:$A);1)

تسلم ايديك أخى سيف الدين

جرب الملف المرفق جمع اللون الاحمر.rar

أخى الفاضل تم تعديل كود اخى الحبيب ياسر ليناسب طلبك Sub CountCells() Dim Cel As Range, x Dim Total As Integer Application.ScreenUpdating = False For Each Cel In ActiveSheet.Range("d7:J7") x = GetCellColorForReals(Cel) If x <> 16777215 Then Total = Total + Cel.Value End If Next Cel Range("L7") = Total Application.ScreenUpdating = False End Sub Function GetCellColorForReals(R As Range) As Long GetCellColorForReals = R.DisplayFormat.Interior.Color End Function

تفضل أخى Valeur Min.rar

تفضل أخى رجب.rar

تفضل أخى Private Sub ComboBox1_Change() ComboBox2_Change End Sub Private Sub ComboBox2_Change() Dim c As Range Dim cc As Range Dim LR As Integer If ComboBox1.Text = "" Or ComboBox2.Text = "" Then TextBox1 = "" TextBox2 = "" End If LR = Cells(Rows.Count, 1).End(xlUp).Row For Each c In Range("A5:A" & LR) For Each cc In Range("C4:O4") If c = ComboBox1.Text And cc = ComboBox2.Text Then TextBox1 = Cells(c.Row, 2) TextBox2 = Cells(c.Row, cc.Column) Exit For End If Next Next End Sub رجب.rar

تفضل أخى Valeur Min.rar

أخى الفاضل المرفق به مشكلة لا يمكن تحميله برجاء رفعه مرة أخرى

أخى الفاضل عندك البديل وهو دالة SUMIFS لها أكثر من شرط

جرب أخى هذا الكود Sub ragab() Dim x As Integer Dim cl As Range Dim Rng As Range Set Rng = Range("A2:A50") For Each cl In Rng If cl.Font.Bold = True And cl <= 25 Then x = x + 1 End If Next Range("C1") = x End Sub

أخى الحبيب محمود الشريف جزاك الله كل خير تسلم ايديك

تفضل أخى المصنف1.rar

أخى الفاضل / الدهشورى كما أخبرك الأستاذ خالد الرشيدى لا يمكن عمل ذلك بالمعادلات

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

أخى الفاضل جرب هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) Dim LR As Integer LR = Cells(Rows.Count, "I").End(xlUp).Row If Not Intersect(Target, Range("I5:I" & LR)) Is Nothing Then If Target.Count > 1 Then Exit Sub If Target = "سداد - خالص" And Target.Offset(0, -1) <> 0 Then Target.Offset(0, 1) = Target.Offset(0, -1) Target.Offset(0, -1) = 0 Target.Offset(0, -2) = Target.Offset(0, -3) End If End If End Sub مديونيات1.rar

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

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

أخى الفاضل أحمد لا يوجد ملف مرفق

بارك الله فيك مجهود جبار تسلم ايديك

بارك الله فيك أستاذ محمد عمل جميل ومميز