اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

المشرفين السابقين
  • Posts

    13,165
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    412

كل منشورات العضو ياسر خليل أبو البراء

  1. وعليكم السلام هل سيتم إدخال ثلاثة أرقام بشكل يدوي؟ ما الغرض في هذه الحالة ؟ ولما لا يكون التوزيع للأرقام بشكل عشوائي لكل الأرقام جرب الكود التالي لعله يفي بالغرض Sub GenerateUniqueRandom() Dim b() As Boolean, e As Range, k&, x& Const r As Long = 14 ReDim b(1 To r) For Each e In Range("A2:C5") Do x = Int(Rnd() * r) + 1 If b(x) = False Then e.Value = x b(x) = True Exit Do End If k = k + 1: If k > 1000 Then Exit Sub Loop Next e End Sub
  2. وعليكم السلام بارك الله فيك أخي الحبيب خالد الرشيدي وأعتقد أن فكرتك ممتازة بخصوص تقسيم المصفوفة الأخ العزيز ناصر سعيد .. إذا كنت لا تريد بيانات في الأعمدة P و Q فيمكنك في نهاية الكود وضع سطر يقوم بعملية مسح للبيانات المستجلبة .. مجرد فكرة
  3. هل الخلايا محمية ... من المفترض قبل وضع حماية للورقة أن تقوم بتحديد الخلايا المطلوبة ثم كليك يمين ثم Format Cells واذهب للتبويب الأخير وتأكد من وجود علامة صح بجانب الخيار Locked والخيار Hidden
  4. بارك الله فيك أخي العزيز ناصر وجزيت خيراً على دعائك الطيب .. والحمد لله الذي بنعمته تتم الصالحات
  5. لربما بسبب اهتزاز الشاشة وهنا يمكن استخدام السطر التالي في بداية الكود بعد الإعلان عن المتغيرات Application.ScreenUpdating=False وفي نهاية الكود نفس السطر مع تغيير القيمة False إلى True
  6. يتم وضع الكود في محرر الأكواد في موديول جديد .. شاهدي الفيديو التالي لتعرفي أساسيات التعامل مع الأكواد وإليكي ملف مرفق مطبق فيه الكود .. Sample.rar
  7. وعليكم السلام الفكرة ببساطة هنا هو أن نحصل على الرقم 1 في أول صف في النتائج ... وهنا يتم الاعتماد على الدالة Row لمعرفة رقم الصف الحالي ... وبما أن النتائج ستبدأ في الصف الثالث عشر .. فلكي نحصل على الرقم 1 يتم طرح 13 - 12 ليساوي الرقم 1 أي أن هذا الجزء مرتبط برقم صف البداية للنتائج تقبل تحياتي
  8. وعليكم السلام قومي بتنسيق أعمدة ورقة النتائج كنص من خلال كليك يمين على خلايا ورقة العمل ثم اختاري Format Cells ثم اختاري Text ثم جربي الكود التالي Sub Test() Dim coll As New Collection, arr, maxItem As Long, i As Long, j As Long, str1 As String, v1, v2 arr = Sheets("Sheet1").Range("A1").CurrentRegion.Value For i = 1 To UBound(arr, 1) str1 = CStr(arr(i, 1)) On Error Resume Next coll.Add Key:=str1, Item:=New Collection On Error GoTo 0 If coll(str1).Count = 0 Then coll(str1).Add str1 For j = 2 To UBound(arr, 2) If Len(arr(i, j)) Then coll(str1).Add CStr(arr(i, j)) Next j Next i For Each v1 In coll If v1.Count > maxItem Then maxItem = v1.Count Next v1 ReDim arr(1 To coll.Count, 1 To maxItem) i = 0 For Each v1 In coll i = i + 1 j = 0 For Each v2 In v1 j = j + 1 arr(i, j) = v2 Next v2 Next v1 For j = 2 To maxItem arr(1, j) = j - 1 Next j Sheets("Sheet2").Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr End Sub
  9. أين الجزء الذي فيه نسخ التنسيق .. يفترض أنك تريد نسخ التنسيق من نطاق أو خلايا محددة باستخدام الأمر Copy أين هو في الكود؟ ثم إن السطر التالي غير منطقي إذ لابد من الإشارة لنطاق محدد للصق التنسيقات فيه .. راجع شرح الصورة مرة أخرى PasteSpecial Paste:=xlPasteFormats
  10. جرب تضع نقطة توقف عند بداية الفورم الذي لا يفتح ثم من لوحة المفاتيح استخدم F8 لتتبع الكود سطر بسطر لتعرف السطر الذي يسبب المشكلة أعتذر لعدم قيامي بذلك لقلة الوقت لدي
  11. جرب حذف السطر التالي من الكود حيث أنه يقوم بتحويل المعادلات لقيم ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
  12. أخي الكريم أبو سارة .. جربت كود الأخ الحبيب خالد ويعمل بشكل جيد جداً عموماً إثراءً للموضوع هذا كود آخر مقارب لكود الأخ خالد لعله يفيدك Sub PopulateNumbers() Dim cell As Range Dim x As Long Dim lr As Long Range("C3:C1000").ClearContents For Each cell In Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Row) x = cell.Offset(, 1) lr = Cells(Rows.Count, 3).End(xlUp).Row + 1 Range("C" & lr).Resize(x, 1).Value = cell.Value Next cell End Sub
  13. بعد هذا السطر Set sh = ThisWorkbook.Sheets("شيكات " & ActiveSheet.Name) قم بوضع سر لفك الحماية بهذا الشكل sh.Unprotect "Pass" حيث الكلمة Pass التي بين قوسي التنصيص هي كلمة السر وفي نهاية الكود قم بإرجاع الحماية مرة أخرى بعد هذا السطر sh.Cells(lr, 5).Value = ws.Range("F10").Value ضع السطر التالي ws.Protect "Pass"
  14. يمكنك قبل نهاية الكود الإشارة للخلايا المطلوب مسحها ثم مسحها باستخدام ClearContents مثال : Range("B2:C2").ClearContents
  15. وعليكم السلام جرب الكود التالي Sub ExportActiveSheetToNewWorkbook() 'YasserKhalil *** 07-06-2017 '--------------------------- Dim wb As Workbook Dim ws As Worksheet Dim str As String Set ws = ActiveSheet str = ws.Range("A2").Value Application.DisplayAlerts = False If wb Is Nothing Then ws.Copy ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value Set wb = ActiveWorkbook If Dir(ThisWorkbook.Path & "\ملفات العملاء\" & str & ".xlsx") <> "" Then MsgBox "Workbook Is Already Existing", vbCritical wb.Close False Else wb.SaveAs Filename:=ThisWorkbook.Path & "\ملفات العملاء\" & str & ".xlsx" wb.Close True MsgBox "Workbook Exported Successfully ...", 64 End If End If Set ws = Nothing Set wb = Nothing Application.DisplayAlerts = True End Sub
  16. أهلا بك أخي الكريم في المنتدى يرجى طرح موضوعك في موضوع مستقل حيث لا يتلفت عادةً للمشاركات الفرعية ، مع ذكر التفاصيل للمطلوب وإرفاق ملف
  17. استخدم الكود التالي في هذه الحالة لكل البنوك .. الكود مرن وكل ما عليك هو ربطه بالصورة الموجودة في أوراق البنوك Sub TransferBankDetails() 'YasserKhalil *** 07-06-2017 '--------------------------- Dim ws As Worksheet Dim sh As Worksheet Dim lr As Long Application.ScreenUpdating = False Set ws = ActiveSheet Set sh = ThisWorkbook.Sheets("شيكات " & ActiveSheet.Name) If Left(ws.Name, 5) <> "البنك" Then Exit Sub lr = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 sh.Cells(lr, 1).Value = ws.Range("B2").Value sh.Cells(lr, 2).Value = ws.Range("D7").Value sh.Cells(lr, 3).Value = ws.Range("A8").Value sh.Cells(lr, 5).Value = ws.Range("F10").Value Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub
  18. قمت بتحميل ملفك وفتح معي .. ولكن الملف ليس به معادلات أو أكواد إنما مجرد نموذج لكشف حساب
  19. للنطاق المتغير يمكن الاعتماد على رقم آخر صف به بيانات وقد تناولت طريقة الحصول على رقم آخر صف به بيانات في الفيديو التالي
  20. أي ملف أخي الكريم ارفق الملف لنحاول تجربته وموافتك بنتيجة عمله من عدمها إذا كان الملف يحتوي على أكواد فلابد من تفعيل الماكرو لديك في نسخة الأوفيس التي قمت بتنصيبها
  21. اطلع على الرابط التالي
  22. وعليكم السلام يرجى تغيير العنوان .. راجع موضوع التوجيهات في الموضوعات المثبتة في صدر المنتدى
  23. أعتقد الاسم ورقة1 وليس ورقة 1 أي الاسم يكون بدون مسافة
×
×
  • اضف...

Important Information