سليم حاصبيا

هذه المعادلة =CHOOSE(MATCH(D2,$D$2:$D$8),$D$2,$D$3,$D$4,$D$5,$D$6,$D$7,$D$8)*CHOOSE(MATCH(C2,$C$2:$C$8),$C$2,$C$3,$D$4,$C$5,$C$6,$C$7,$C$8)+B2

جرب هذا الملف (يتم فصل الارقام اينما وجدت في أول النص او وسطه او اخره) فصل الارقام عن النص salim.rar

يمكن استعمال هذه الدّالة Option Explicit Function salim_if(rg As Range) salim_if = IIf(rg = 1, "ناجح", IIf(rg = 2, "راسب", "")) End Function انظر الى المرفق Boook_IIf.rar

جرب هذا الملف Classeur11 salim.rar

ارقع ملفاُ نموذجاً(50 سطر )عما تريد

استبدل الماكرو بهذا Option Explicit Sub Hid_rows() Dim i!, t% Application.ScreenUpdating = False Sheets("Sheet1").Rows.Hidden = False For i = 5 To Sheets("Sheet1").Cells(Rows.Count, 1).End(3).Row t = Evaluate("=SUMPRODUCT(--((B" & i & ":F" & i & ")=0 " & "))") If t = 5 Then Range("b" & i).EntireRow.Hidden = True Next Application.ScreenUpdating = true End Sub

بعد اذن اخي عبدالله هذا الكود Option Explicit Sub Hid_rows() Dim i! Sheets("Sheet1").Rows.Hidden = False For i = 5 To Sheets("Sheet1").Cells(Rows.Count, 1).End(3).Row If Application.CountA(Range("b" & i & ":F" & i)) = 0 Then Range("b" & i).EntireRow.Hidden = True End If Next End Sub

اكسل لا يقوم باخفاء خلية او عدة خلايا بل العامود كاملاً او الصف كاملاً

من المعروف ان دالة INDIRECT غير موجودة في الـــ VBA لكن بواسطة دالة معرفة يمكن الزامها على العمل شاهد هذا الملف iNDIRECT_VBA.rar

جرب هذا الكود Option Explicit Sub translate_data() Dim Rg_To_Paste As Range Dim Rg_To_Copy As Range Dim Col% Dim i% Dim Sh As Worksheet, Ih As Worksheet Application.ScreenUpdating = False Set Sh = Sheets("store"): Set Ih = Sheets("in") Set Rg_To_Copy = Sh.Range("b1:b27") If IsEmpty(Rg_To_Copy.Cells(2)) Or IsEmpty(Rg_To_Copy.Cells(3)) Then GoTo 1 Col = Ih.Cells(4, Columns.Count).End(1).Column + 1 Ih.Activate For i = 0 To 500 If Application.CountA(Ih.Range(Cells(4, Col), _ Cells(27, Col)).Offset(0, i)) = 0 Then Exit For Next Rg_To_Copy.Copy Ih.Cells(1, i + 4) 1: Sh.Activate Set Rg_To_Paste = Nothing: Set Rg_To_Copy = Nothing Set Ih = Nothing: Set Sh = Nothing Application.CutCopyMode = False Application.ScreenUpdating = True End Sub الملف مرفق Tarhil_Salim.rar

تمت الاجابة عن هذا السؤال في العنوان التالي: https://www.officena.net/ib/topic/79306-new-member/

جرب هذا الملف w sh salim.rar

انسخ هذه المعادلة الى الخلية I4 قم بتنفيذها مع (Ctrl+Shift+Enter)و ليس Enter وحدها =IFERROR(MIN(IF($G$4&"*"&$H$4=$A$2:$A$1217&"*"&$B$2:$B$1217,$C$2:$C$1217,"")),"No Data") و نفس المعادلة الى الخلية J4 مع استبدال MIN بــــ MAX اذا لم تعمل معك استبدل الفاصلة ", " بفاصلة منقوطة "; " حسب اعدادات الجهاز عندك لتصبح المعادلة هكذا: (Ctrl+Shift+Enter)و ليس Enter وحدها =IFERROR(MAX(IF($G$4&"*"&$H$4=$A$2:$A$1217&"*"&$B$2:$B$1217;$C$2:$C$1217;""));"No Data")

مرفق الحل 1----تم معالجة الامر في الصفحة (يومية تسجيل) 2----اكتب فقط التاريخ المطلوب في الخلية D4 (الخلية الصفراء) في الصفحة /تقرير وفاتورة/ (و اكسل يقوم بجميع العمليات الحسابية ) (حتى و لو كان الشهر 30 يوماً او 28) اذ كتبت اي تاريخ فإن اكسل يضيف اليه اوتوماتيكياً 15 يوم يشرط الا يتجاوز ذلك اخر الشهر في الجدول في حال عدم وجود التاريخ المطلوب في صفحة (يومية تسجيل) لا تحصل على نتائج الخلايا التي تحتوي على معادلات محمية / ضد التغيير و ليس ضد المسح/ (لعدم العبث يها عن طريق الخطأ) المصنف1 SALIM.rar

تم التعديل جمع salim2.rar

تم التعديل قليلاً على الملف 1-بحيث يسمح لك بالكتاية داخل الورقة حتى و لو كان اليوزر ظاهراً 2- لا حاجة للترقيم (اكسل يفعل ذلك اوتوماتيكياً) لذلك جعلت Text1 غير فعّال بيان2 Salim.rar

سأعمل على تلبية الطلب قريباً

ارفع ملفاً غير محمي و بدون تنسيقات (أصفر ابيض الخ...) و دون خلايا مدمجة فقط الجداول الثلاثة

بعد ان اخي زيزو هذا الكود للتحذير Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Answer% If Target.Address <> "$A$1" Then Exit Sub Answer = MsgBox("The range (""C2:C4"") ,Will be Deleted..No Way to Undo." & Chr(10) & "are you sure you want to do this?..", 260) If Answer <> 6 Then Exit Sub Range("C2:C4").ClearContents End Sub

بمكن التعديل ايضاً على الكود بخيث يسمح بالتنسيق و ذلك بهذه الاضافة البسيطة ActiveSheet.Protect AllowFormattingCells:=True .protect تكتب مباشرة مكان

هذا لان الورقة محمية بعد تنفيذ الكود لذلك يجب اولاً ايقاف الكود عن العمل (بوضع فاصلة عليا امام اول سطر منه) ثانياً الغاء الحماية عن الشيت ثالثاً-اجراء التنسيقات اللازمة و اخيراً السماح للكود بالعمل(ازالة الفاصلة العليا امام اول سطر منه)

جرب هذا الملف الكود Option Explicit Sub copy_column() Dim Message1, Message2 Dim Rg2 As Range Dim arr() Dim Answer%, i%, LastCol% Message1 = Application.InputBox("Give range to Copy", Type:=8) Message2 = Application.InputBox("Give the column's Number in Sheet2", Type:=1) Set Rg2 = Sheets("sheet2").Columns(Message2) '================================ For i = LBound(Message1, 1) To UBound(Message1, 1) ReDim Preserve arr(1 To i) arr(i) = Message1(i, 1) Next '=================================== If Application.CountA(Rg2) > 0 Then Answer = MsgBox("the destination range is not empty" & Chr(10) & " do you want to OverWrite" _ , vbYesNoCancel) If Answer = 2 Then GoTo 1 If Answer = 6 Then Rg2.Delete Sheets("sheet2").Cells(1, Message2).Resize(UBound(arr) - LBound(arr) + 1, 1) = _ Application.Transpose(arr) Else LastCol = Sheets("sheet2").Cells(1, Columns.Count).End(1).Column Sheets("sheet2").Cells(1, Message2).Offset(0, LastCol).Resize(UBound(arr) - LBound(arr) + 1, 1) = _ Application.Transpose(arr) End If Erase arr Exit Sub End If Sheets("sheet2").Cells(1, Message2).Resize(UBound(arr) - LBound(arr) + 1, 1) = _ Application.Transpose(arr) 1: Erase arr End Sub الملف مرفق CopY_column.rar

تسنطيع اجراء اي تنسيق على اي خلية(او محموعة خلايا) شرط الا يحتوي النطاق على معادلات

استبدل اول 4 أسطر من الكود الى هذا الاسطر الاربعة (يوضع في حدث Thisworkbook وليس في موديل مستقل) Option Explicit Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Application.EnableEvents = False With ActiveSheet

لا بديل عن CTRL + SHIFT + ENTER لان المعادلة من نوع صفيف Array_Formula و لما الحاجة لاعادة الضغط على الخلية ؟ يكفي ان تنفّذ المعادلة مرة واحدة و كلما غيرت بالخلية E2 تستحيب المعادلة وتعطيك النتيجة اذا حددت الخلية عليك و اردت الخروج لا تضغط Enter بل CTRL + SHIFT + ENTER او يمكنك الضغط على Esc (لعدم تغيير محتويات المعادلة) الافواس } يضعها اكسل اوتوماتيكياً بعد الضفط على(CTRL + SHIFT + ENTER) ليقول لك انه فهم عليك ان المعادلة من نوع صفيف Array_Formula