ياسر خليل أبو البراء

وعليكم السلام جرب الكود التالي في حدث ورقة العمل Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Row > 8 Then If Target.Column = 8 Or Target.Column = 9 Or Target.Column = 10 Then Cancel = True Target.Value = Format(Time, "hh:mm") End If End If End Sub

بارك الله فيك أخي الغالي زيزو العجوز .. كود رائع واستخدام أروع للدالة CHOOSE في تحديد الأعمدة المطلوب ترحيلها .. جزاك الله خير الجزاء على كل ما تقدمه لإخوانك تقبل وافر تقديري واحترامي

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

وجزيت خيراً بمثل ما دعوت لي أخي الكريم تقبل تحياتي

السلام عليكم استخدم الدالة TRUNC بهذا الشكل =TRUNC(A1,2)

وعليكم السلام أخي الغالي خالد الرشيدي بارك الله فيك وجزاك الله خيراً على كلماتك الطيبة .. وجزيت خيراً بمثل ما دعوت لي وزيادة

جرب الكود التالي Sub Test() Dim r As Range For Each r In Range("D5:D" & Cells(Rows.Count, "D").End(xlUp).Row).SpecialCells(2, 1).Areas r(r.Count + 1).Formula = "=subtotal(9," & r.Address & ")" r(r.Count + 1).Offset(, 1).Formula = "=subtotal(9," & r.Offset(, 1).Address & ")" Next End Sub

أخي الكريم الخازمي المسار يكون بالشكل التالي "C:\Users\4\Desktop\saes\" بدون مسافات مع وضع علامة : بعد رمز الدرايف

وعليكم السلام ورحمة الله وبركاته تفضل أخي الكريم

بارك الله فيك أخي الحبيب عبد الله أخي الكريم الذول يمكنك استخدام الدالة MID لاستخراج العدد المطلوب من الأرقام .. ابحث عن الدالة وشرحها لتتعلم كيف تنفذ الأمر بنفسك فالأمر بسيط إن شاء الله

الخطأ كان في هذا السطر بشكل خاص lrow = Range("d" & Rows.Count).End(xlUp) حيث يشير إلى نطاق والمطلوب أن يكون معبر عن رقم آخر صف لذا تمت إضافة الخاصية .Row وهي تجلب رقم آخر صف ... وبما أننا نريد وضع بيانات في صف جديد فتم إضافة الرقم 1 إذا أردت الإشارة لورقة عمل أخرى سيكون عليك أن تغير رقم فهرس الورقة من خلال السطر التالي Sheets(1).Activate

جرب التعديل التالي Private Sub CommandButton1_Click() Sheets(1).Activate lrow = Range("d" & Rows.Count).End(xlUp).Row + 1 Range("d" & lrow).Value = ComboBox1.Value Range("d" & lrow).Offset(0, 1).Value = TextBox1.Value Range("d" & lrow).Offset(0, 2).Value = TextBox2.Value Range("d" & lrow).Offset(0, 3).Value = TextBox3.Value Range("d" & lrow).Offset(0, 4).Value = TextBox4.Value Range("d" & lrow).Offset(0, 5).Value = TextBox5.Value Range("d" & lrow).Offset(0, 6).Value = TextBox6.Value ComboBox1.Value = "" TextBox1.Value = "" TextBox2.Value = "" TextBox3.Value = "" TextBox4.Value = "" TextBox5.Value = "" TextBox6.Value = "" End Sub

وعليكم السلام جرب الكود التالي Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim arr As Variant Dim temp As Variant Dim i As Long Dim j As Long Dim c As Long Dim b As Boolean Dim t As Double Set ws = Sheets("السجل") Set sh = Sheets("وصل") arr = ws.Range("A4:J" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value ReDim temp(1 To UBound(arr, 1), 1 To 4) sh.Range("A4:D" & Rows.Count).ClearContents For i = LBound(arr, 1) To UBound(arr, 1) If arr(i, 2) = sh.Range("A2").Value Then If b = False Then sh.Range("B2").Value = arr(i, 3) sh.Range("G4").Value = arr(i, 8) b = True End If j = j + 1 For c = 4 To 7 temp(j, c - 3) = arr(i, c) Next c t = Application.WorksheetFunction.Sum(t, arr(i, 9)) End If Next i If j > 0 Then sh.Range("F4").Value = t sh.Range("A4").Resize(j, UBound(temp, 2)).Value = temp End If End Sub

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

بارك الله فيك أستاذي الحبيب محمد صالح أخي الكريم زاكي شاهد الفيديو التالي لعله يفيدك في بعض الأساسيات https://youtu.be/59WvTJvdfOQ

السلام عليكم جرب الكود التالي Sub Test() Dim r As Long Dim c As Long Dim t As Variant Dim b As Boolean Application.ScreenUpdating = False For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row b = False For c = 2 To 14 If Not IsEmpty(Cells(r, c)) Then t = Cells(r, c) Next c For c = 2 To 14 If Cells(r, c) <> t And Not IsEmpty(Cells(r, c)) Then b = True If b And Not IsEmpty(Cells(r, c)) Then Cells(r, 1).Interior.Color = vbCyan Cells(r, c).Interior.Color = vbGreen End If Next c Next r Application.ScreenUpdating = True End Sub

أخي الكريم ارفق الملف نفسه وليس الفورم فقط .. حيث عند استيراد الفورم يحدث خطأ

تفضل أخي الكريم الكود في ملف مرفق .. Test.rar

بارك الله فيك أخي الحبيب سليم اطلعت على الملف ووضعت الكود بناء على فهمته من الشرح وإن كان غير ذلك ننتظر رد الأخ السائل .. جزيت خيراً على الاهتمام بالموضوع .. تقبل وافر تقديري واحترامي

ضع الكود التالي في حدث المصنف ... سيعمل الكود عند تنشبط ورقة العمل (جرب الانتقال لورقة أخرى وارجع لورقة العمل وسيعمل الكود) Private Sub Workbook_SheetActivate(ByVal Sh As Object) Sh.Range("F6").Value = Sh.Name End Sub

اعتقدت أنك تبحث في عمود الحالة وليس العمود الأول .. عموماً لو شاهدت الفيديو الخاص بالكود يمكنك فهم كيفية عمل الكود بشكل أفضل الحمد لله أن تم حل المشكلة تقبل تحياتي

وعليكم السلام ورحمة الله وبركاته استخدم خاصية البحث والاستبدال واختر من النافذة الخاصة بذلك Workbook ليشمل البحث أوراق العمل كافة والتعديل سيكون على كافة نتائج البحث مرة واحدة اضغط Ctrl + H من لوحة المفاتيح ..

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

وعليكم السلام ورحمة الله وبركاته جرب التعديل التالي Sub UsingArrays() Dim arr As Variant Dim temp As Variant Dim lr As Long Dim i As Long Dim j As Long Dim c As Long Sheets("Sheet2").Range("E6:H1000").Clear lr = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row arr = Sheets("Sheet1").Range("A2:D" & lr).Value ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2)) j = 1 For i = LBound(arr, 1) To UBound(arr, 1) If arr(i, 4) = Range("K5") Then For c = LBound(arr, 2) To UBound(arr, 2) temp(j, c) = arr(i, c) Next c j = j + 1 End If Next i If j = 1 Then MsgBox "Invalid Criteria", vbExclamation: Exit Sub Sheets("Sheet2").Range("E5").Resize(, UBound(temp, 2)).Value = Array("الكود", "الأسماء", "الدرجات", "الحالة") Sheets("Sheet2").Range("E6").Resize(j - 1, UBound(temp, 2)).Value = temp End Sub

وعليكم السلام جرب الكود التالي Sub Test() Dim iRow As Long Dim iCol As Long Dim iCount As Long Application.ScreenUpdating = False For iRow = 2 To 20 Step 3 For iCol = 1 To 17 Step 2 Cells(iRow, iCol).Value = 100000 + iCount iCount = iCount + 1 Next iCol Next iRow Application.ScreenUpdating = True End Sub