أ / محمد صالح

التواصل مع صاحب الكود لتعديله ليتوافق مع نسخ 64 بت او تغيير نظام التشغيل ل 32بت

الموضوع بسيط جدا أحدث تاريخ يمكنك استعمال دالة max للخلايا التي بها تواريخ مثلا =max(b2,d2,f2,.......) وهكذا آخر عمود فيه تاريخ وبالنسبة لإجمالي القيم يمكنك استعمال دالة sum للخلايا التي بها قيم مثلا =sum(a2,c2,e2,.......) بالتوفيق

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

يمكنك عمل ذلك من خلال التنسيق الشرطي عن طريق معادلة =OR(C$6="الجمعة",C$6="السبت") وتطبق على الخلايا C7:AH56 بالتوفيق

لم أقل في موديول جديد وإنما قلت في حدث التغيير يعني عند تغيير محتوى الخلايا في الشيت وتمت إضافة الطريقة في المنشور الأصلي

يمكنك تجربة هذه الكود في حدث التغيير في شيت قوائم الفصول مع تصويب اسم الشيت قاعدة البيانات كلك يمين على اسم الشيت قوائم الفصول ثم view code ثم لصق هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$5" Then Dim wsDatabase As Worksheet Dim wsLists As Worksheet Dim lastRow As Long Dim i As Long Dim maleRow As Long, femaleRow As Long Dim lastMaleNumber As Long Set wsDatabase = ThisWorkbook.Sheets("قاعدة البيانات") Set wsLists = ThisWorkbook.Sheets("قوائم الفصول") wsLists.Range("A7:C40").ClearContents wsLists.Range("D7:F40").ClearContents maleRow = 7 femaleRow = 7 lastRow = wsDatabase.Cells(wsDatabase.Rows.Count, "B").End(xlUp).Row For i = 2 To lastRow If wsDatabase.Cells(i, "C").Value = wsLists.Range("D5").Value Then If wsDatabase.Cells(i, "D").Value = "ذكر" Then wsLists.Cells(maleRow, 1).Value = maleRow - 6 wsLists.Cells(maleRow, 2).Value = wsDatabase.Cells(i, "B").Value wsLists.Cells(maleRow, 3).Value = wsDatabase.Cells(i, "M").Value maleRow = maleRow + 1 End If End If Next i lastMaleNumber = maleRow - 7 femaleRow = 7 For i = 2 To lastRow If wsDatabase.Cells(i, "C").Value = wsLists.Range("D5").Value Then If wsDatabase.Cells(i, "D").Value = "انثى" Then wsLists.Cells(femaleRow, 4).Value = lastMaleNumber + (femaleRow - 6) wsLists.Cells(femaleRow, 5).Value = wsDatabase.Cells(i, "B").Value wsLists.Cells(femaleRow, 6).Value = wsDatabase.Cells(i, "M").Value femaleRow = femaleRow + 1 End If End If Next i End If End Sub بالتوفيق

الكود في الملف مكتوب لنواة ويندوز مختلفة مثلا 32بت والنسخة الحالية 64بت وإذا كان لك صلاحية الدخول على الكود يمكنك وضع كلمة ptrsafe قبل اسم الدالة أو الإجراء مثل هذا الكود #If VBA7 Then Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr #Else Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long #End If بالتوفيق

يمكنك استعمال هذه المعادلة في الخلية D6 =IFERROR(INDEX(الاسماء!$G$6:$G$215,MATCH(الخطة!D6,الاسماء!$F$6:$F$215,0)),"") ثم سحب المعادلة للأسفل ويسارا وإذا كنت تستعمل النسخ الحديثة للأوفيس يمكنك استعمال هذه المعادلة بدون سحب في الخلية D6 فقط' =IFERROR(INDEX(الاسماء!$G$6:$G$215,MATCH(الخطة!D6:AD230,الاسماء!$F$6:$F$215,0)),"") بالتوفيق

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

هذا يعتمد على طريقة بنائك لعناصر القائمة ليست بوكس أثناء إضافة العناصر إليها يمكنك التحكم في تنسيق القيم الموجودة في الخلايا مثلا بهذه الصورة Dim i As Integer For i = 1 To 10 ListBox1.AddItem Format(Cells(i, 1).Value, "0.00") Next i هذا الكود يقوم بإضافة الخلايا من A1:A10 إلى القائمة وتنسيق الرقم بها إلى رقمين عشريين بالتوفيق

لقد تم حل مثل هذه المشكلات كثيرا يجب البحث اولا وهذه أحد نتائج البحث Showing results for 'القروش خليتين' in content posted in منتدى الاكسيل Excel . - أوفيسنا (officena.net) بالتوفيق

بارك الله فيكم جميعا ولإثراء الموضوع وترتيب الكود وتنظيمه يمكننا استعمال هذه الدالة بعد التحسين تم جعل الأسماء المركبة بدلالة الكلمة الأولى في مصفوفة منفصلة عن الأسماء المركبة بدلالة الكلمة الثانية يمكن احضار الاسم الأول بتمرير رقم 1 في المعامل الثاني للدالة ويمكن احضار اسم الاب برقم 2 أو بدون المعامل الثاني Function SplitName(Name As String, Optional part As Integer = 2) As String Dim K As String, S As String, N As Integer, M As Integer, FirstName As String Dim startsNames As Variant, endsNames As Variant, sName As Variant K = Trim(Name): M = Len(K): S = " " ' مصفوفة الأسماء المركبة التي تبدأ بكلمات معينة startsNames = Array("عبد", "أبو", "ابو", "ام", "أم", "ذو", "امرؤ", "سيف", "زين", "روح", "عين") ' مصفوفة الأسماء المركبة التي تنتهي بكلمات معينة endsNames = Array("الله", "الدين", "بالله", "الزهراء", "الهدى") If InStr(1, K, S, 1) = 0 Then SplitName = Name Exit Function End If ' التحقق من الأسماء المركبة التي تبدأ بكلمات معينة For Each sName In startsNames If Left(K, Len(sName) + 1) = sName & " " Then FirstName = Left(K, InStr(Len(sName) + 2, K, S, 1) - 1) SplitName = IIf(part = 1, FirstName, Mid(K, Len(FirstName) + 1, Len(K))) Exit Function End If Next ' التحقق من الأسماء المركبة التي تنتهي بكلمات معينة For Each sName In endsNames If InStr(1, K, sName, vbTextCompare) > 0 Then FirstName = Left(K, InStr(1, K, sName, vbTextCompare) + Len(sName) - 1) SplitName = IIf(part = 1, FirstName, Mid(K, Len(FirstName) + 1, Len(K))) Exit Function End If Next ' إذا لم يكن الاسم مركبًا، عرض الاسم الأول فقط FirstName = Left(K, InStr(1, K, S, 1) - 1) SplitName = IIf(part = 1, FirstName, Mid(K, Len(FirstName) + 1, Len(K))) End Function بالتوفيق

كيف وضعت المعادلة ضمن صفيف؟؟؟ الصواب أن تضغط كنترول وشيفت وانتر بدلا من انتر فقط في النسخ القديمة من الأوفيس. أما في الحديثة يكتفى بانتر فقط بالتوفيق

ما شاء الله أنت وصلت لمستوى جميل لماذا تقول أنك مبتدئ؟ أقترح عليك الاعتماد على العمود F في تحديد القائمة يمكنك تجربة هذا التعديل Sub WhatsApp() Dim Contact As String Dim Message As String Dim Obj As New DataObject Dim lr As Long lr = Cells(Rows.Count, "F").End(xlUp).Row For Each Cell In Range("F2:f" & lr) Contact = Cell.Value Message = Cell.Offset(0, 2).Value Obj.SetText Message Obj.PutInClipboard ActiveWorkbook.FollowHyperlink "https://wa.me/" & Contact Application.Wait(Now + TimeValue("00:00:06")).True Call SendKeys("^v", True) Application.Wait(Now + TimeValue("00:00:05")).True Call SendKeys("~", True) Application.Wait(Now + TimeValue("00:00:05")).True Next MsgBox "Done!" End Sub بالتوفيق

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

عليكم السلام ورحمة الله وبركاته يمكنك تجربة هذا الكود Sub TransferData() Dim wsCurrent As Worksheet Dim wsPrevious As Worksheet Dim lastRow As Long Dim i As Long Dim j As Long Dim targetRow As Long ' تحديد الشيت الحالي والشيت السابق Set wsCurrent = ThisWorkbook.Sheets("6") ' قم بتغيير اسم الشيت حسب الحاجة Set wsPrevious = ThisWorkbook.Sheets("5") ' قم بتغيير اسم الشيت حسب الحاجة ' إيجاد آخر صف في الشيت الحالي lastRow = wsCurrent.Cells(wsCurrent.Rows.Count, "B").End(xlUp).Row ' مسح الصفوف التي تحتوي على كلمة "منقول" في العمود M For i = lastRow To 7 Step -1 If wsCurrent.Cells(i, "M").Value = "منقول" Then wsCurrent.Rows(i).Delete End If Next i ' إيجاد آخر صف بعد المسح lastRow = wsCurrent.Cells(wsCurrent.Rows.Count, "B").End(xlUp).Row ' ترحيل البيانات من الشيت السابق targetRow = lastRow + 1 For i = 7 To wsPrevious.Cells(wsPrevious.Rows.Count, "B").End(xlUp).Row If wsPrevious.Cells(i, "M").Value = "منقول" Then For j = 1 To 21 ' الأعمدة من A إلى U If j >= 6 And j <= 12 Then wsCurrent.Cells(targetRow, j).Formula = wsPrevious.Cells(i, j).Formula Else wsCurrent.Cells(targetRow, j).Value = wsPrevious.Cells(i, j).Value End If Next j targetRow = targetRow + 1 End If Next i ' ترتيب البيانات حسب الاسم في العمود B wsCurrent.Range("A7:U" & targetRow - 1).Sort Key1:=wsCurrent.Range("B7"), Order1:=xlAscending, Header:=xlNo End Sub بالتوفيق

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

إذا عرضت الدالة الموجودة في vba ربما يمكن تحويلها إلى جوجل سكريبت لأن الأمر يحتاج إلى دراية بلغة vba ولغة جافا سكريبت

ربما يرجع السبب لأن معادلة filter و xloojup توجد في الإصدارات الحديثة فقط من أوفيس 2021 وما بعدها أو 365 مثلا

إذا كان لديك دالة معرفة في vba اسمها topten يجب تحويلها إلى جوجل سكريبت حتى تعمل في جوجل شيت

عليكم السلام ورحمة الله وبركاته يمكنك تجربة هذا الكود Sub MoveDataWithoutDeletingRows() Dim ws As Worksheet Dim lastRow As Long Dim i As Long, startRow As Long Set ws = ThisWorkbook.Sheets("Sheet1") ' قم بتغيير اسم الورقة حسب الحاجة lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row startRow = 1 ' يمكنك تغيير قيمة startRow حسب الحاجة For i = startRow To lastRow If Application.WorksheetFunction.CountA(ws.Range("A" & i & ":E" & i)) > 0 Then If i <> startRow Then ws.Range("A" & i & ":E" & i).Copy Destination:=ws.Range("A" & startRow & ":E" & startRow) End If startRow = startRow + 1 End If Next i ' مسح البيانات من الصفوف الأصلية دون حذف الصفوف ws.Range("A" & startRow & ":E" & lastRow).ClearContents End Sub بالتوفيق

عليكم السلام ورحمة الله وبركاته يمكنك وضع اسماء الفصول في الصف 11 ووضع هذه المعادلة في الخلية D12 =IFERROR(COUNTIF(OFFSET(أساسية!$A$1,MATCH($C12,أساسية!$B$1:$B$100,0)-1,0,1,50),D$11),"") ويمكنك سحبها يسارا لتجلب أعداد باقيد الفصول وسحبها لأسفل لباقي المعلمين بالتوفيق

هذا التصميم للقوائم معتمد على اختيار واحد في N3 وما على يسارها في الصف الثالث ويصعب جدا تكرار كل هذه القوائم المساعدة لكل صف لذلك تحتاج إلى تغيير طريقة العمل إذا كنت بحاجة إلى نسخ الخلايا التي بها القوائم لأسفل أقترح عمل الآتي: وضع جميع عناصر القائمة في الصفوف التي أسفلها وتسمية هذا النطاق باسم رأس القائمة (طبعا اسم النطاق لا يوجد به مسافات لذلك يجب استبدال المسافات ب _ ) وإذا كان عنصر من هذه العناصر يندرج تحته عناصر أخرى يجب وضعه في عمود جديد وتسمية عناصره باسمه وهكذا وللحصول على القائمة الخاصة بالخلية A2 مثلا نضع في الخلية B3 قائمة التحقق ونضع مصدرها المعادلة التالية =INDIRECT(SUBSTITUTE(A3, " ", "_")) وهكذا مع باقي الأعمدة ويمكنك الرجوع لهذه الروابط بالتوفيق

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

اخي الكريم صاحب الاستفسار انا ما شفت الملف لأني على الموبايل لذلك قمت بترجمة ما قلته حضرتك الي معادلة هذه الجملة تعني انك تريد تاريخ قبل G2 بمدة من شهر الي 60 شهر سابق وهذا ما تقوم به المعادلة أما حكاية تغيير قيمة الخلية لأنها تنشئ رقما عشوائيا وإذا أردت تثبيت المدة مثلا تاريخ سابق ل G2 بعشرين شهر أو 30 شهر يمكنك تغيير الجزء الخاص ب RANDBETWEEN الي هذا الرقم الثابت انا دائما اعطي فكرة الحل وليس الحل امتثالا للحكمة القائلة لا تعطني سمكة ولكن علمني كيف اصطاد فكرتي هي استخدام EDATE يمكنك توظيفها كما تشاء بالتوفيق