اذهب الي المحتوي
أوفيسنا

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

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

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

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

  • Days Won

    412

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

  1. بارك الله فيك أخي العزيز ناصر سعيد وجعله الله في ميزان حسناتك يوم القيامة تقبل وافر تقديري واحترامي
  2. السلام عليكم ارفق ملف موضحاً فيه المطلوب أخي الكريم
  3. تفضل أخي الكريم محمود التعديل التالي .. عله يفي بالغرض إن شاء الله Private Sub CommandButton6_Click() Dim ws As Worksheet Dim r As Range Set ws = Worksheets("ss") For Each x In ws.Range("A101:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row) If x = ComboBox1.Text Then x = x.Row Exit For End If Next x Set r = ws.Cells(x, 1) r.Offset(0, 1) = TextBox3.Text r.Offset(0, 2) = TextBox4.Text r.Offset(0, 3) = TextBox5.Text r.Offset(0, 5) = TextBox6.Text r.Offset(0, 6) = TextBox7.Text If CheckBox1.Value = True Then r.Offset(0, 4) = True If CheckBox2.Value = True Then r.Offset(0, 4) = False End Sub
  4. قصدت حذف النطاق وليس مسح محتوياته ...
  5. الحمد لله الذي بنعمته تتم الصالحات تقبل تحياتي
  6. طيب ممكن تعطيني مثال للخطأ الذي يحدث معك وفي أي سطر يحدث الخطأ لأستطيع مساعدتك .. وهل تقصد بالإخفاء أن الورقة غير مرئية أم أن الورقة تكون غير نشطة وورقة أخرى هي النشطة؟
  7. أخي الكريم المفترض أن تقوم بتثبيت نطاق البيانات بوضع علامة الدولار ..لاحظ السطر التالي =IFERROR(VLOOKUP(A3,فبراير!2:1194,2,FALSE),"not") قم بتثبيت النطاق بهذا الشكل =IFERROR(VLOOKUP(A3,فبراير!$2:$1194,2,FALSE),"not")
  8. أخي الحبيب سليم جرب حذف النطاق A5:C6 ولاحظ النتائج ..
  9. وعليكم السلام أخي الكريم الخطأ الموجود يعني أن العنصر غير موجود في ورقة البحث #N/A لذا يمكن تغيير المعادلة بهذا الشكل لتجنب الخطأ ضع المعادلة التالية في الخلية D3 ثم قم بسحبها لأسفل .. =IFERROR(VLOOKUP(A3,فبراير!$A$2:$B$2000,2,FALSE),"")
  10. ما هو الإجراء المطلوب تعديله لديك في الملف؟ حدد الإجراء وما هو المطلوب عمله وسأحاول إن شاء الله الإطلاع عليه في أقرب وقت
  11. في الأكواد الموجودة راجعها وأشر لورقة العمل قبل النطاق Range أو Cells بهذا الشكل نفترض أنك قمت بتعيين ورقة العمل ss في المتغير المسمى ws وكان لديك هذا السطر Range("A1").Value="Test" فقم بوضع المتغير المسمى ws والذي يشير لورقة العمل المعنية بهذا الشكل قبل السطر السابق ws.Range("A1").Value="Test"
  12. بارك الله فيك أخي الكريم محمود وكل عام وأنت بخير لم أفهم المطلوب بالنسبة للتعديل المطلوب .. وفي الواقع الأفضل تخصيص موضوع مستقل لكل طلب لكي يكون أيسر وأكثر تفاعل من الأعضاء مع تحديد المطلوب بدقة كأن تذكر اسم الإجراء المطلوب التعديل عليه وما هي النتائج المتوقعة بعد التعديل وصدقني بالرغم من سهولة طلبك في المشاركة الأخيرة إلا إنني عانيت لأفهم المطلوب بالضبط حيث أن الملف يحتوي على عمل ليس بالقليل ، لذا أنصحك بتحديد المطلوب وإعطاء كافة المعطيات لتجد استجابة أفضل كأن تقول المطلوب في ورقة العمل كذا أن يتم كذا وكذا وذلك من خلال زر الأمر الموجود على الفورم المسمى كذا ، والمتوقع أن تكون النتائج كذا .. وهكذا وهكذا تقبل تحياتي
  13. السلام عليكم أخي الكريم محمود استبدل الكود الموجود في زر الأمر CommandButton8 بهذا الكود Private Sub CommandButton8_Click() Dim ws As Worksheet Set ws = Worksheets("ss") For Each x In ws.Range("A100:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row) If x = ComboBox1.Text Then x = x.Row Exit For End If Next x m = MsgBox("سيتم حذف هذه العلاوة؟هل انت متأكد من اجراء هذه العملية", vbYesNo) If m = vbYes Then ws.Rows(x).Delete MsgBox "برجاء التأكد من حذف اى علاوة تاريخها اكبر من التى ستقوم بادخالها حتى لا يضر النتائج" Me.TextBox2.Value = "" Me.TextBox3.Value = "" Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" CheckBox1.Value = False CheckBox2.Value = False Me.ComboBox1.Value = "" Else MsgBox "! لم يتم حذف العلاوة" End If End Sub
  14. بارك الله فيك أخي العزيز زيزو وجزيت خيراً على مساعداتك القيمة في كافة الموضوعات أخي الكريم عبد الرحمن المشكلة لديك في اسم ورقة العمل البرمجي .. في ملفك الأخير ليست باسم Sheet1 وإنما باسم ورقة1 جرب الملف المرفق التالي فيه كود الأخ زيزو ASA1--2003.rar
  15. تأكد من أن الحساب لديك في الملف تلقائي وليس يدوي
  16. بارك الله فيك أخي الحبيب سليم بعد الإطلاع على ملفك وجدت أنك قمت بتحويل البيانات من أفقي لعمودي ، وليس كما هو مطلوب في عنوان الموضوع من عمودي لأفقي
  17. السلام عليكم يرجى تغيير اسم الظهور للغة العربية أخي الكريم جرب الكود التالي .. ضع الكود في موديول عادي وبعد تنفيذ الكود ستجد النتائج في ورقة2 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:C" & Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row).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 = 3 To maxItem - 2 Step 2 arr(1, j + 1) = "الشهر" arr(1, j + 2) = "الراتب" Next j Sheets("Sheet2").Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr End Sub
  18. إذا كان لدي علم بالموضوع وفهمت المطلوب بشكل جيد لا أتردد في المشاركة أخي الكريم رشراش ربما لو طرحت موضوع جديد وأرفقت ملف وذكرت كافة التفاصيل مع وضع بعض النتائج المتوقعة لربما وجدت المساعدة من الجميع وليس مني وحدي كل عام وأنت بخير
  19. وجزيت خيراً بمثل ما دعوت لي أخي الكريم تقبل تحياتي
  20. احذف كلمة Sheet1 من هذا السطر (ستجدها مرتين) ..ومعها النقطة التي تليها أيضاً وكذلك احذفها من آخر سطر بالنقطة التي تليها أو ... استبدل كلمة Sheet1 بكلمة ورقة1
  21. وعليكم السلام أخي الكريم عبد الرحمن جرب الكود التالي عله يفي الغرض Sub Test() Dim arr As Variant Dim str As String Dim i As Long arr = Sheet1.Range("A1:A" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row).Value For i = LBound(arr, 1) To UBound(arr, 1) str = arr(i, 1) arr(i, 1) = Trim(Split(Mid(str, InStrRev(str, "\") + 1), ".")(0)) Next i Sheet1.Range("B1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr End Sub
  22. وعليكم السلام أخي الكريم أحمد تفضل الملف المرفق فيه ما تطلب إن شاء الله تحميل الملف المرفق من هنا
  23. وجزيت خيراً بمثل ما دعوت لي أخي العزيز والحمد لله أن تم المطلوب على خير
  24. لم تذكر شكل النتائج المتوقعة كما طلبت منك عموماً جرب الكود بهذا الشكل Option Explicit Sub ImportDataFromClosedWBs_YasserKhalil() Dim strFolder As String Dim strFile As String Dim wbk As Workbook Dim sh As Worksheet Dim lr As Long Dim i As Long With Application .ScreenUpdating = False .Calculation = xlManual .DisplayAlerts = False .AskToUpdateLinks = False End With strFolder = ThisWorkbook.Path & "\الفواتير\" strFile = Dir(strFolder & "*.xls*") Do While strFile <> "" Set wbk = Workbooks.Open(strFolder & strFile) Set sh = wbk.Worksheets(1) With ThisWorkbook.Worksheets(1) i = 7 lr = IIf(.Cells(Rows.Count, 1).End(xlUp).Row < 3, 3, .Cells(Rows.Count, 1).End(xlUp).Row + 1) .Range("G" & lr).Resize(1, 2).Value = sh.Range("A2").Resize(1, 2).Value .Range("I" & lr).Value = sh.Range("F1").Value .Range("J" & lr).Value = sh.Range("F2").Value .Range("K" & lr).Value = sh.Range("F3").Value .Range("O" & lr).Value = sh.Range("B2").Value Do .Range("A" & lr).Resize(1, 6).Value = sh.Range("A" & i).Resize(1, 6).Value lr = IIf(.Cells(Rows.Count, 1).End(xlUp).Row < 3, 3, .Cells(Rows.Count, 1).End(xlUp).Row + 1) i = i + 1 Loop Until sh.Range("A" & i).Value = "" End With wbk.Close False strFile = Dir Loop With Application .AskToUpdateLinks = True .DisplayAlerts = True .Calculation = xlAutomatic .ScreenUpdating = True End With End Sub
×
×
  • اضف...

Important Information