سليم حاصبيا

تم معالجة الامر Ijraat_new.xlsm

الماكرو اللازم (تم تغيير اسم الصفحة الى salim لسهولة نسخ الكود و لصقه دون ظهور أحرف غريبة وغير مقروئة) Option Explicit Sub Ijraat_By_Code() Dim R% With Sheets("salim") R = .Cells(1, "A").CurrentRegion.Rows.Count .Range("E1").CurrentRegion.Offset(1).ClearContents With .Range("E2").Resize(R - 1, 9) .Formula = "=IF(ISNUMBER(FIND(E$1,$C2)),E$1,"""")" .Value = .Value End With End With End Sub الملف مرفق Ijraat.xlsm

جرب هذا الملف ملاحظة: عندك اخطاء بكتابة العناوين في الاعمدة اذ يجب كتابة الكلمة بالضبط كما في في النص (دون زيادة او نقصان في المسافات ) مثلاُ محضر استلام تراها في النصوص هكذا ( محضر استلام) (مسافتين بين محضر و استلام) الامر نفسه بالنسبة لباقي النصوص Ijraat.xlsm

جرب هذا الكود بعد الضغط على زر هات ما عندك تظهر لك رسالتين الرسالة الاولى تطلب منك رقم العامود الذي تريد التصفية عليه (الافتراضي رقم 6 حيث رقم العميل) الرسالة الثانية تطلب منك اسم العميل الذي على اساسه تريد التصفية) النتيجة في شيت Salim اي خطأ في اسم العميل او رقم العامود لا تظهر النتائج Filter_by_choise.xlsm

وأين أجد اسم العميل (اقصد في اي عامود)

اكثر من رائع لكن ارجو تقبل هذه الملاحظة: عدم استعمال كلمات محجوزة للـــ VBA كأسماء للمتغيرات مثلاً كلمة Count هي احداها لذلك يمكن استعمال بديل مثلاً Cont على العموم انا افضل المصفوفات في هذه الحالة لانها أسرع انت تستطيع ان تجمع كل المعطيات في مصفوفة واحدة وتلصقها رأسًا في النطاق اللازم و في النهاية تقوم بمسح محتويات المصفوفة Erase ARR لتحرير الذاكرة منها جرب هذا الكود Sub B() Dim ARR(), k%: k = 0 Range("B10", Range("B9").End(4)).ClearContents For i = 2 To 7 For j = 1 To 6 k = k + 1 ReDim Preserve ARR(1 To k) ARR(k) = "'" & (j & " / " & Cells(i, 1)) Next j Next i Range("b10").Resize(k) = Application.Transpose(ARR) Erase ARR End Sub

حدد اتجاه الكتابة من اليسار الى اليمين

انظر الى هذا الملف aaشيت.xlsm

ادرج فاصلة عليا قبل كتابة اسم الفصل(لا تظهر في الخلية انما تخبر الاكسل ان هذا ليس رقماُ)

ممكن ان تكون احد الخلايا في الصف الثاني فارغة او ليست رقماً (مما يوقف الكود عن العمل )

جرب هذا الماكرو Option Explicit Sub del_rows() Dim arr() Dim y%, i% Dim Rg As Range With Sheets("ورقة1") y = Cells(2, Columns.Count).End(1).Column If y < 5 Then Exit Sub arr = Application.Transpose(.Cells(2, 5).Resize(, y - 4)) arr = Application.Transpose(arr) For i = LBound(arr) To UBound(arr) If IsNumeric(arr(i)) Then If Rg Is Nothing Then Set Rg = .Cells(arr(i), 1) Else Set Rg = Union(Rg, .Cells(arr(i), 1)) End If End If Next i Rg.Rows.Delete End With End Sub

جرب هذا المعادلة واسحب نزولاً =IF(OR(D2="",D2="Not Found"),"",INDIRECT("B"&D2))

يمكن ان تضيف الاسماء دون array لكن باستعمال array يكون الماكرو اسرع و كما قلت لك يمكنك تكبير array قدر ما تشاء ولو كان هنا 100000 احتمال

في هذا الملف نموذج عما تريد فقط اكمل المصفوفة بما تشاء من اختصارات و ما يقابلها من اسماء ونفذ الماكرو Option Explicit Sub replace_Please() Dim my_rg As Range Dim arr(1 To 3) Dim st$ Dim i% arr(1) = "مصط" & "*": arr(2) = "حس" & "*": arr(3) = "عيد" & "*" Set my_rg = Range("f1").CurrentRegion For i = LBound(arr) To UBound(arr) Select Case arr(i) Case "مصط" & "*": st = "مصطفى" Case "حس" & "*": st = "حسين" Case "عيد" & "*": st = "عبد" End Select my_rg.Replace What:=arr(i), Replacement:=st, LookAt:=xlPart Next End Sub الملف مرفق Replacement.xlsm

الامر ليس بهذه البساطة مثلاً اذا اردت ان تستبدل كل شيء يبدأ بـــ حس و اخذت في الماكرو ( "حس* ":= what ) فان البرنامج يستبدل حسن و حسني و حسام باسم حسين اذا كان المستبدل في الماكرو هو حسين

الملف غير مفهومه الغاية منه لماذا تريد استبدال علي بـــ علي ومصطفى بــ مصطفى طالما الاسمين موجودين

يمكن ان تستعين بالمعادلات الموجودة في هذا الملف لتكملة ملفك الخاص working_hours.xls

يا سيدي (لان العداد يبدأ من الخلية A2 ) اي ان الصف 2 رقمه 1 بنظر المعادلة أضف واحد على المعادلة =IFERROR(MATCH(A2,$B$2:$B$194750,0)+1,"Not Found")

جرب هذا المعادلة في الخلية D2 ثم اسحب نزولاً =IFERROR(MATCH(A2,$B$2:$B$194750,0),"Not Found") اذا لم تعمل معك المعادلة استبدل الفاصة بفاصلة منقوطة لتبدو المعادلة بهذا الشكل =IFERROR(MATCH(A2;$B$2:$B$19475;0);"Not Found")

استعمل هذه المعادلة في DATA VALIDATION CUSTOM =AND(OR(LEFT(C4,1)*1=1,LEFT(C4,1)*2=2),SUM(IF(ISNUMBER(--(MID(C4,ROW($2:$12),1))),1,0))=11) الملف مرفق مع المطلوب Aziz_data_val.xlsx صديقي علي المعادلة التي وضعتها لا تفي بكل الشروط فانها مثلاً تسمح بان يكون اول رقم غير 1 او 2 او ان تحتوي حرف وليس فقط ارقام

أظن انه لا حاجة للكود فقط هذه المعادلة =IF($D10="","",SUMPRODUCT((تصفية!$K$12:$K$111=$D10)*(تصفية!$G$12:$G$111=$D$7)*(تصفية!$H$12:$H$111))) الملف مرفق مع المعادلات اللازمة ww_sal.xlsm

لم افهم ماذا تعني عبارة بشرط عدم تساوى طرفىه

ارفع نموذج مختصر (ليس 700 كيلو) بدون زركشة ألوان تبهر النظر

جرب هذا الماكرو الاسم المطلوب في الخلية A1 تم تغيير اسماء الشيتات الى source_sh و target_sh لحسن عملية نسخ الكود ونقله بحيث لا تظهر حروف غريبة Sub Find_Recorde() Rem Created By Salim Hasbaya On 24/9/2019 Dim S As Worksheet: Set S = Sheets("source_sh") Dim T As Worksheet: Set T = Sheets("target_sh") Dim Nam: Nam = T.Cells(1, 1) Dim My_RG As Range Dim Saerch_Rg As Range T.Cells(3, 1).CurrentRegion.Clear Dim col%, Ro%, Actual_ro% Set Saerch_Rg = S.Columns(5).Find(Nam, lookat:=1) If Saerch_Rg Is Nothing Then MsgBox _ "This Name Dos not exit or Wrong Name" Exit Sub End If Ro = Saerch_Rg.Row + 1 col = S.Cells(Ro, Columns.Count).End(1).Column Actual_ro = S.Cells(Ro, 1).End(4).Row - Ro + 1 With T.Cells(3, 1).Resize(Actual_ro, col) .Value = S.Cells(Ro, 1).Resize(Actual_ro, col).Value .Borders.LineStyle = 1 .NumberFormat = "[$-,10A] ddd d mmm yyyy" .Interior.ColorIndex = 24 .Font.Bold = True End With End Sub الملف مرفق Record.xlsm