مهند الزيدي

شكرا اخي محمد عادل وفقك الله لكل خير

شكرا أخي العزيز " محمد عادل" وفقك الله لكل خير .. عذرا على الإطالة لا أرى أنك إستعملت الدالة FORMULATEXT ...وظهرت صيغة المعادلة

شكرا اخي رجب... وفقكم الله لكل خير

شكرا لكل أخي العزيز " محمد عادل " ... شكرا لك أخي العزيز " رجب جاويش " وفقكم الله لكل خير ... أخي العزيز رجب مامعنى (109) في المعادلة على أي شي تدل...؟ أخي العزيز محمد عادل كيف يمكن أظهار صيغة المعادلة في الخليةبدل الناتج بدون فارزة مفردة أو مسافة ؟

أخي العزيز ياسر خليل وفقكم الله لكل خير .. ممكن شرح الكود Sub GetData() Dim Col As Long Dim Data As Variant Dim Dict As Object Dim N As Long Dim Rng As Range Dim Row As Long Dim Table As Variant Dim Wks As Worksheet Dim Addr As String Set Dict = CreateObject("Scripting.Dictionary") Dict.CompareMode = vbTextCompare ReDim Table(1 To 6, 1 To 1) For Each Wks In ThisWorkbook.Worksheets If Wks.Name <> "تصفية حسب الأشهر" Then Set Rng = Wks.Range("A1").CurrentRegion.Columns(2) Set Rng = Intersect(Rng, Rng.Offset(1, 0)).Resize(ColumnSize:=2) Col = Col + 1 Data = Rng.Value Addr = Rng.Address For N = 1 To UBound(Data) If Not Dict.Exists(Data(N, 1)) Then Row = Row + 1 Dict.Add Data(N, 1), Row ReDim Preserve Table(1 To 6, 1 To Row) Table(Col, Row) = Data(N, 2) Else Table(Col, Dict(Data(N, 1))) = Data(N, 2) End If Next N End If Next Wks Table = Application.Transpose(Table) With Worksheets("تصفية حسب الأشهر") .Range("B2").Resize(Dict.Count, 1).Value = Application.Transpose(Dict.Keys) .Range("C2").Resize(UBound(Table, 1), UBound(Table, 2)).Value = Table End With End Sub

شكرا اخي العزيز رجب جاويش.. شكرا للاخ محمد الخازمي .. شكرا للاخ ياسر خليل .. اخي ياسر عند تنفيذ الظغط على زر اظهار الفورم .. نظهر الرسالة الخطأ كما في الصور المرفقة

تفضل أخي العزيز ... كلمة المستخدم 1234 كلمة المرور 1234 start form.rar آسف اخي رجب ,,, لم ار مشاركتك استاذي العزيز .. وفقك الله لكل خير

أخي العزيز " المسلم العربي " أرسل المرفق الذي له مشكلة .. ليتسى للإخوة حل المشكلة

وفقك الله لكل خير .. اخي ياسر لاتوجد علامة (') أو فراغ قبل المعادلة .. هل هو كود أو ماذا

عمل رائع وفقك الله لكل خير .. كيف يمكن عرض صيغة المعادلة في الخلية بدلا من النتيجة ؟ كما في شرح الأخ محمد عادل .. في العمود (I)

وفقكم الله على مجهودكم الرائع .. هل من الممكن عمل مشاركة لملف اكسل على عدة مستخدمين مع إمكانية التعديل على نفس الشيت في وقت واحد من قبل المستخدمين ؟ نرجو من مشرفي أوفسنا الأفاضل تثبيت الموضوع ..للوصول الى أكثر الحلول حول هذا الموضوع

انا ايضا جربت الكود ولم تحدث معي اي مشكلة ... شكرا أخي ياسر على الكود الإكثر من رائع .. مع شكري للإستاذ رجب جاويش

شكرا اخي العزيز رجب .. اطال الله في عمرك

ظهرت لدي هذه الحالة عدة مرات .. نرجوا مساعدة المشرفين وفقهم الله لكل خير

شكرا اخي رجب جاويش .. وفقك الله لما فيه الخير... ممكن شرح للكود

السلام عليكم .. ممكن عمل كود إخفاء الأعمدة عندما تكون قيمة خلية المجموع في العمود تساوي صفر ..وفقكم الله لكل خير إخفاء الأعمدة.rar

شكرا لك أخي العزيز ياسر خليل .. وفقكم الله لكل خير .. أشكر إستجابتك ..وآسف جدا على طلباتي المتكررة ..تفضل المرفق كود منع حذف صف.rar

شكر خاص الإخ رجب جاويش عودة أكثر من رائعة.. أخي رجب ممكن كود يقوم بإخفاء الإعمدة عندما تكون خلية قي الصف تساوي صفر مثلا إذا كانت الخلية A20 =0 يقوم بأخفاء العمود A وكذلك بقية الاعمدة الى مثلا Z حسب قيمة الخلية 20 فيه

السلام عليكم... ممكن كود يقوم بمنع حذف صف أو خلية في صف معين ..مع امكانية التعديل أو الإضافة في الخلية.... وفقكم الله لكل خير

للرفع ولع المنتدى .. بحضور العمالقة محمد الخازمي .. رجب جاويش.. والمبدع ياسر خليل

شكرا لك اخي العزيز ياسر .. الموضوع مطروح مسبقا على الرابط

أخي العزيز " ياسر " هل ممكن تعديل على الكود الترحيل التالي الذي هو أحد أبداعاتك .. لكي نتخلص من القص واللصق والتكرار... وكذلك من مسألة Clear content مابعد الترحيل لكي لا يقوم بتكرار ترحيل نفس الحقل أو عند تغيير الحقل Sub TarhilData() Dim WS As Worksheet, SH As Worksheet Dim X As Long, Y As Long, Cell As Range Dim lRow As Long Set WS = Sheets("ÇáÈíÇäÇÊ"): Set SH = Sheets("ÃÌæÑ ÇáØÈíÈ") Application.ScreenUpdating = False For Each Cell In WS.Range("P2:p11") If Not IsEmpty(Cell) Then X = Application.WorksheetFunction.Match(Cell.Value, SH.Rows(1), 0) lRow = SH.Cells(49, X).End(xlUp).Row + 1 WS.Range(Cell.Offset(, -14), Cell.Offset(, -12)).Copy SH.Cells(lRow, X).PasteSpecial xlPasteValues Cell.Offset(, 12).Copy SH.Cells(lRow, X + 8).PasteSpecial xlPasteValues On Error Resume Next Y = Application.WorksheetFunction.Match(Cell.Offset(, -15), Range(SH.Cells(2, X), SH.Cells(2, X + 8)), 0) SH.Cells(lRow, X + Y - 1).Value = Cell.Offset(, -1).Value On Error GoTo 0 End If Next Cell Application.CutCopyMode = False Application.ScreenUpdating = True End جدول إجور.rar

شكرا لك أخي العزيز ياسر خليل.. أخي رجب جاويش .. أسعدتنا عودتك ..وفقكم الله لكل خير

شكرا لك أخي العزيز محمود الشريف .. سأجرب واوافيك بالنتيجة... وفقك الله لكل خير

للرفع