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

الأخ الحبيب أببو يوسف راجع هذا الموضوع وفيه موضوعات مشابهة لطلبك بشكل كبير http://www.officena.net/ib/index.php?showtopic=58438&hl=%2B%D8%A7%D9%84%D8%AA%D8%A7%D8%B1%D9%8A%D8%AE+%2B%D8%AA%D9%84%D9%82%D8%A7%D8%A6%D9%8A راجع الرابط أو ابحث في المنتدى ولو قابلك أي مشكلة هتلاقينا موجودين إن شاء الله تقبل تحياتي

الأخ الفاضل لم أقصد بالملف المرفق أن تقوم بنسخ الكود في ملف نصي وتضعه ..بل أن ترفق ملف الإكسيل الذي به الكود !!!! ويرجى ضغط الملف ورفعه على سيرفر المنتدى ..بلاش الروابط الخارجية راجع التوجيه الثاني عشر http://www.officena.net/ib/index.php?showtopic=60147

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

راجع المشاركة رقم 3 ويرجى تغيير اسم الظهور للغة العربية غير الفاصلة بفاصلة منقوطة , ; جربت !!

الأخ الفاضل minor يرجى تغيير اسم الظهور للغة العربية يؤخذ عليك أنك لم توضح المطلوب بشكل كاف ..كان من المفترض وضع بعض النتائج للشكل المتوقع عموما أنا عملت لك ورقة عمل مخفية اسمها Temp ممكن تغير شكلها بس دا هيبتعه تغير في بعض أسطر الكود عموما جرب الكود التالي عله يفي بالغرض الكود يحذف أي ورقة عمل غير ورقة السجل ثم يقوم بإنشاء أوراق عمل جديدة تبعا للقيم الموجودة في منطقة التجنيد ثم يستدعي البيانات في كل ورقة عمل .. جرب الملف بشكل مستفيض وأخبرنا بالنتائج Sub CreateSheets() Dim WS As Worksheet, SH As Worksheet Dim Cell As Range, lRow As Long Set WS = Sheets("السجل") Application.ScreenUpdating = False Application.DisplayAlerts = False Temp.Visible = True For Each SH In ThisWorkbook.Sheets If SH.Name <> "السجل" And SH.Name <> "Temp" Then SH.Delete End If Next SH For Each Cell In WS.Range("J5:J" & WS.Cells(Rows.Count, 10).End(3).Row) For Each SH In ThisWorkbook.Sheets If SH.Name = Cell.Value Then GoTo 1 Next SH Sheets("Temp").Copy After:=Sheets(Sheets.Count) Sheets("Temp (2)").Name = Cell.Value Range("A1").Value = ActiveSheet.Name 1 Sheets(Cell.Value).Activate With ActiveSheet lRow = .Cells(Rows.Count, "F").End(3).Row + 1 .Range("A" & lRow).Value = lRow - 3 .Range("B" & lRow).Value = Cell.Offset(, -8).Value .Range("C" & lRow).Value = Cell.Offset(, -6).Value .Range("D" & lRow).Value = Cell.Offset(, -5).Value .Range("E" & lRow).Value = Cell.Offset(, -4).Value .Range("F" & lRow).Value = Cell.Offset(, -3).Value .Range("G" & lRow).Value = Cell.Offset(, -2).Value .Range("H" & lRow).Value = Cell.Offset(, -1).Value .Range("I" & lRow).Value = Cell.Offset(, 1).Value End With Next Cell Temp.Visible = False Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub لا تنسى أن تحدد أفضل إجابة التزاماً بقواعد وتوجيهات المنتدى تقبل تحياتي Transfer Data & Create Sheets.rar

الأخ الكريم رؤوف بارك الله فيك على كلماتك الطيبة يرجى طرح طلبك في موضوع مستقل مع إرفاق ملف ليساعدك الأخوة الأفاضل الطلبات الموجودة في المشاركات عادةً لا يلتفت إليها تقبل تحياتي

أخي الكريم عزيز عرابي إليك هذا التعديل البسيط Sub FilterAndCopy() Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Dim lngLastRow As Long Dim OKSheet As Worksheet, ErrorSheet As Worksheet Set OKSheet = Sheets("Sheet2") Set ErrorSheet = Sheets("Sheet3") lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row 'مسح محتويات النطاق الذي سيتم إدراج النتائج به OKSheet.Columns("A:E").ClearContents ErrorSheet.Columns("A:E").ClearContents With Range("A1", "E" & lngLastRow) .AutoFilter .AutoFilter Field:=5, Criteria1:=">0" .Copy OKSheet.Range("A1") .AutoFilter Field:=5, Criteria1:="<0" .Copy ErrorSheet.Range("A1") .AutoFilter End With Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic End Sub تم وضع تعليق على السطرين المطلوبين

المطلوب غير واضح يرجى إرفاق ملف ..

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

أخي الكريم أبو سليمان اعذرني لعدم متابعتي للموضوع من البداية .. لو توضح مرة أخرى طلبك بملف مرفق أكون لك شاكر ... سؤال آخر : ما المشكلة في الكود الذي قدمه أخونا الكبير خزاني ؟ وضح بالتفصيل .. زي ما بتحتاج شرح بالتفصيل وضح إنت كمان بالتفصيل ويمكنك مراجعة هذا الرابط http://www.officena.net/ib/index.php?showtopic=56941#entry374440 الحلقة دي بتتكلم عن الترتيب والفرز لعله يفيدك

أخي الحبيب إبراهيم أبو ليلة لكم يسعدني مرورك العطر بموضوعي المتواضع جزيت خيراً وبارك الله فيك تقبل تحياتي

الأخ الفاضل شريف يرجى تغيير اسم الظهور للغة العربية كما يرجى تحديد أفضل إجابة ليظهر الموضوع مجاب

أخي الفاضل يرجى تغيير اسم الظهور للغة العربية راجع الرابط التالي فيما يخص طلبك http://www.officena.net/ib/index.php?showtopic=61139

رابط الحلقة الأولى الحلقة الأولى - دورة أساسيات إكسل 2013 من تحت الصفر إلى الاحتراف رابط الحلقة الثانية الحلقة الثانية من دورة أساسيات إكسل 2013 من تحت الصفر إلى الاحتراف رابط الحلقة الثالثة الحلقة الثالثة - دورة أساسيات إكسل 2013 من تحت الصفر إلى الاحتراف رابط الحلقة الرابعة الحلقة الرابعة - دورة أساسيات إكسل 2013 من تحت الصفر إلى الاحتراف رابط الحلقة الخامسة الحلقة الخامسة - دورة أساسيات إكسل 2013 من تحت الصفر إلى الاحتراف مع تحياتي أ / محمد صالح

الأخ الفاضل أبو لجين (اللجين هي الفضة على ما أعتقد) الحمد لله أن تم المطلوب على خير يرجى تحديد أفضل إجابة ليظهر الموضوع مجاب ومنتهي التزاماً بقواعد المنتدى

أخي وحبيبي ونور عيني مختار تسلم على تشجيعك الدائم لي..بارك الله فيك وجزيت خيراً على كل ما تقدمه لمصلحة إخوانك في الله ورداً على كلامك الشديد : أنا بكلامك والله دايما سعيد ، وأنا بين إخواني بالمنتدى بكون كأني في عيد ، وسلم لي على أبو عيد ، وسلامي من هنا لكل أهل الصعيد تقبل تحياتي

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

الأخ الفاضل يرجى تغيير اسم الظهور للغة العربية جرب المعادلة التالية في التنسيق الشرطي .. إذا لم تعمل المعادلة قم باستبدال الفاصلة بفاصلة منقوطة =AND(E7<25,OR(D7<5,D7="غ"),A7=0)

أخي الحبيب يرجى تحديد أفضل إجابة ليظهر الموضوع مجاب .. ولا مانع من طرح موضوع جديد إذا كان لديك طلب جديد

أخي في الله أ / محمد صالح لم يفلح الأمر معي .. وجربت كلا الطريقتين في الدالة المعرفة .. لو أمكن تحويل الدالة إلى كود لنصل إلى حل أكون لك مشكور من فترة كنت طرحت موضوع مشابه بالكود http://www.officena.net/ib/index.php?showtopic=57543&hl= ولكن بالفعل كلامك صحيح يبدو أنها أصبحت غير مجانية (يا للأسف) في انتظار إبداعاتك يا معلمي

جربت هذا الكود Sub Test() Dim Cell As Range For Each Cell In Range("A1:A5") Cell.Offset(, 1).Value = mas_g_trans(Cell.Value, "en") Next Cell End Sub ولكن عند التنفيذ قام بترجمة أول خليتين فقط .. هل المشكلة في Readystate .. هل يمكن عند تنفيذ الكود جعل الـ IE يفتح مرة واحدة فقط .. أم أنه لابد أن يفتح مع كل إجراء جديد ؟؟

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

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

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله مع كل جديد ومفيد في عالم الإكسيل الشيق ، أقدم لكم دالة معرفة UDF ، تقوم الدالة بإظهار المعادلات في أي خلية ، وتعرضها كنص ... الدالة بالشكل التالي Function FormText(CellRef As Range, Optional RefIndicator As Integer) As String Dim N As Integer, F As Integer If IsNull(RefIndicator) = True Then RefIndicator = 0 End If FormText = CellRef.Formula If RefIndicator > 0 Then FormText = "[" & CellRef.Address & "] " & FormText End If N = 1 F = InStr(1, FormText, "]") Do While N < F If RefIndicator = 1 And Mid(FormText, N, 1) = "$" Then FormText = Trim(Left(FormText, N - 1) & Mid(FormText, N + 1, 200)) End If If Mid(FormText, N, 1) = "," Then FormText = Trim(Left(FormText, N) & " " & Mid(FormText, N + 1, 200)) End If N = N + 1 Loop End Function وفي الملف المرفق شرح بالأمثلة لكيفية استخدام الدالة ، حتى لا أطيل عليكم حمل الملف من هنا دمتم في رعاية الله كان معكم أخوكم ياسر خليل أبو البراء

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