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

وعليكم السلام أهلاً بك أخي الكريم ونورت المنتدى المشكلة بسبب عدم تنصيب اللغة العربية لديك في الويندوز ..قم بتنصيب اللغة العربية من لوحة التحكم Control Panel ..

قم بالإشارة للصفحة المطلوبة قبل بداية السطر يعني مثلاً لو الصفحة هي صفحة "البطاقات الفردية" ودي أسندناها لمتغير باسم sh ..فنضع الـ sh قبل بداية السطر المطلوب جلب رقم آخر صفحة في الورقة المعنية sh.Cells(rows.count,1).end(xlup).row

ما المشكلة التي واجهتك؟

جرب الكود التالي (ضع أسماء الملفات الجديدة في العمود المجاور في العمود الثاني قبل تنفيذ الكود) Sub RenameWBs() Dim strFolder As String Dim strFile As String Dim cel As Range Application.ScreenUpdating = False strFolder = ThisWorkbook.Path & "\" strFile = Dir(ThisWorkbook.Path & "\" & "*.xlsx") Do While strFile <> "" On Error Resume Next For Each cel In Worksheets(1).Range("A1:A" & Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row) If cel.Value = Replace(strFile, ".xlsx", "") Then Name strFolder & strFile As strFolder & cel.Offset(, 1).Value & ".xlsx" Exit For End If Next cel On Error GoTo 0 strFile = Dir Loop Application.ScreenUpdating = True End Sub

وجزيت خيراً بمثل ما دعوت لي أخي الكريم ناصر حددت العدد في الكود لوجود بيانات أسفل البيانات الأخرى عموماً إذا كنت تريد أن يكون مرتبط بآخر صف به بيانات في عمود محدد وليكن العمود الأول استبدل الرقم 140 بالسطر التالي Cells(rows.count,1).end(xlup).row حيث يقوم هذا الجزء بجلب رقم آخر صف به بيانات في العمود الأول .. إذا أردت عمود آخر قم باستبدال الرقم 1 في السطر السابق برقم العمود المطلوب .. أما إذا كنت تريد ربط المتغير بقيمة خلية في ورقة عمل أخرى .. اتبع التالي بفرض أن لديك في الورقة المسماة "Sheet1" في الخلية G5 القيمة المطلوبة ولتكن 410 سيتم الإشارة إلى ورقة العمل يليها الإشارة للخلية المطلوبة بهذا الشكل Sheets("Sheet1").Range("G5").Value ويستخدم هذا الجزء في هذه الحالة بدلاً من الرقم 410 في الكود

موضوع قد يهمك

دا ملف لأخونا ياسر العربي بخصوص هذا الموضوع Convert SUMIF To VBA.rar من جاور القوم أربعين يوووووم صار منهم وإحنا قربنا على أربعين سنة .. يدينا ويديلك طولة العمر أكبير

وعليكم السلام مش مصدق عيني ..يمكن بحلم!!! استنى كدا .. قرصت نفسي يعني صاحي !! أنا مش مسدس نفسي :) عوداً حميداً يا أستاذنا الكبير .. والله ليك وحشة كبيرة

السلام عليكم فيه موضوع بعنوان الشرح المستفيض للمصفوفات http://yasserkhalilexcellover.blogspot.com.eg/2016/10/search-using-arrays.html أعتقد أنه سيفيدك في الموضوع إذا كنت تريد أداء أسرع من الحلقات التكرارية .. حاول فقط التركيز في الشرح وإن شاء الله تقدر تستفيد منه وفقكم الله جميعاً لما فيه الخير والصلاح

وجزيت خيراً بمثل ما دعوت لي أخي الكريم تقبل تحياتي

وعليكم السلام الملف غير موجود حاول رفعه على سيرفر المنتدى بعد ضغطه * هناك نقطة جديدة لم تذكرها من قبل .. الخليه C2 و D2 الفترة المراد عمل الحصر بينها على اساس العمود E فى شيت عام (هل في الخلايا تواريخ ؟؟!!) ولما لم تذكر من البداية كافة التفاصيل ..

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

أخي الكريم حسين الموضوع يحتاج لوقت ومزيد من التفاصيل .. في الملف "مصاريف شهر7--2016" يوجد البند "مسجد 4" ليس له قيم (ما المطلوب في هذه الحالة) .. وهل سيكون كل بند في ورقة عمل مختلفة ومنفصلة؟ الأفضل وضع النتائج المتوقعة ليسهل تخيل المطلوب بشكل أفضل ..

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

وعليكم السلام أعتقد أن الأخ سليم قدم حل ممتاز بالمعادلات ..

وعليكم السلام إثراءً للموضوع جرب الكود التالي Sub Test() Dim curRow As Long Dim col As New Collection Dim itm As Variant Dim cnt As Long Dim rng As Range Dim cel As Range Const firstRow As Integer = 1 'رقم صف البداية Const dataCol As Integer = 1 'رقم العمود مصدر البيانات Const extractCol As Integer = 8 'رقم العمود للنتائج المطلوبة Application.ScreenUpdating = False Set rng = Range(Cells(firstRow, dataCol), Cells(Rows.Count, dataCol).End(xlUp)) On Error Resume Next For Each cel In rng col.Add Item:=cel.Value, Key:=CStr(cel.Value) Next cel On Error GoTo 0 curRow = firstRow For Each itm In col cnt = Application.CountIf(rng, itm) If cnt > 10 Then 'عدد مرات التكرار Cells(curRow, extractCol).Value = itm Cells(curRow, extractCol + 1).Value = cnt curRow = curRow + 1 End If Next itm Application.ScreenUpdating = True End Sub

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

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

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

أو من خلال الأكواد يمكن استخدام الدالة CSTR وهي اختصار لـ Convert to String

روح لمحرر الأكواد ومن Tools اختر References وشوف المكتبات اللي بجوارها كلمة Missing وشيل علامة الصح

جرب الكود التالي Sub TARHEEELL() Dim FS As Worksheet, TS As Worksheet Dim R, ER1, ER2 Set TS = Sheets("data") Set FS = ActiveSheet ER2 = TS.Range("A55555").End(xlUp).Row + 1 Application.ScreenUpdating = False If FS.Name <> "data" Then For ER1 = 3 To FS.Cells(Rows.Count, 1).End(xlUp).Row If FS.Cells(ER1, 1) <> "" And FS.Cells(ER1, 14) <> "مرحل" Then TS.Cells(ER2, 1).Resize(1, 13).Value = FS.Cells(ER1, 1).Resize(1, 13).Value FS.Cells(ER1, 14) = "مرحل" ER2 = ER2 + 1 End If Next ER1 End If Application.ScreenUpdating = True End Sub

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

وعليكم السلام جرب الكود التالي Sub Test() Dim sh As Worksheet Dim i As Long Set sh = Sheets("بطاقة فردية") For i = 1 To 410 Step 2 sh.Range("M3").Value = i ActiveWindow.SelectedSheets.PrintOut Copies:=1 Next i End Sub

عند نقل الكود يراعى أن يتم استثناء أوراق العمل التي لن تقوم بالترحيل منها مثل هذا السطر ويمكن إضافة أوراق أخرى للاستثناء من خلال استخدام كلمة AND لإضافة شروط جديدة If FS.Name <> "data" Then بالنسبة للكود في حدث تغير ورقة العمل لا أرى أن له داعي ويمكن الاستغناء عنه