-
Posts
3,492 -
تاريخ الانضمام
-
تاريخ اخر زياره
-
Days Won
41
نوع المحتوي
المنتدى
مكتبة الموقع
معرض الصور
المدونات
الوسائط المتعددة
كل منشورات العضو رجب جاويش
-
أخى الحبيب / محمود الشريف جزاك الله كل خير على هذه الكلمات الطيبة
-
السلام عليكم وبعد إذن أخى الحبيب / أبو سما أخى الفاضل / محمد ما رأيك فى هذا الكود بدلا من الكود الموجود بالملف حيث يقوم الكود التالى بالترحيل حتى ولو لم تكن الصفحات التى سوف يرحيل إليها موجود فى البداية كما أنه يرحل البيانات بنفس التنسيقات وعمل مسلسل فى الصفحات التى سوف يرحل إليها Sub ragab() Dim cl As Range, sh As Worksheet Application.ScreenUpdating = False For Each sh In ThisWorkbook.Worksheets If Not sh.Name = "Sheet1" Then sh.Range("A2:L1000").ClearContents End If Next LR = Cells(Rows.Count, 1).End(xlUp).Row For Each cl In Range("L2:L" & LR) x = Trim(cl.Value) On Error Resume Next If Worksheets(x) Is Nothing Then Sheets.Add.Name = x Sheets(x).Move After:=Sheets(Sheets.Count) End If Sheets("sheet1").Range("A1:L1").Copy Sheets(x).Range("A1").PasteSpecial xlPasteValues Sheets(x).Range("A1").PasteSpecial xlPasteFormats cl.Offset(0, -11).Resize(1, 12).Copy Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial xlPasteValues Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row, 1).PasteSpecial xlPasteFormats Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row, 1).PasteSpecial xlPasteColumnWidths Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 3).End(xlUp).Row, 1) = Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 3).End(xlUp).Row, 1).Row - 1 Application.CutCopyMode = False Next MsgBox "تم الترحيل بنجاح الى صفحات منفصلة" Sheets("sheet1").Select Application.ScreenUpdating = False End Sub
-
السلام عليكم ورحمة الله وبركاته كل الشكر لأخى الفاضل / شوقى ربيع على هذا الإبداع ولإثراء الموضوع وكما طلب أخى الحبيب / محمود الشريف كود لإنشاء الصفحات إن لم تكن موجودة مع بعض الإضافات الأخرى مثل الترحيل بنفس التنسيقات وعمل مسلسل فى الصفحات المرحل اليها Sub ragab() Dim cl As Range, sh As Worksheet Application.ScreenUpdating = False For Each sh In ThisWorkbook.Worksheets If Not sh.Name = "Sheet1" Then sh.Range("A2:L1000").ClearContents End If Next LR = Cells(Rows.Count, 1).End(xlUp).Row For Each cl In Range("L2:L" & LR) x = Trim(cl.Value) On Error Resume Next If Worksheets(x) Is Nothing Then Sheets.Add.Name = x Sheets(x).Move After:=Sheets(Sheets.Count) End If Sheets("sheet1").Range("A1:L1").Copy Sheets(x).Range("A1").PasteSpecial xlPasteValues Sheets(x).Range("A1").PasteSpecial xlPasteFormats cl.Offset(0, -11).Resize(1, 12).Copy Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial xlPasteValues Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row, 1).PasteSpecial xlPasteFormats Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row, 1).PasteSpecial xlPasteColumnWidths Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 3).End(xlUp).Row, 1) = Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 3).End(xlUp).Row, 1).Row - 1 Application.CutCopyMode = False Next MsgBox "تم الترحيل بنجاح الى صفحات منفصلة" Sheets("sheet1").Select Application.ScreenUpdating = False End Sub قاعدة بيانات اعدادى2.rar
-
أخى الحبيب / محمد أبو البراء جزاك الله كل خير على هذا العمل القيم
-
أخى الفاضل جرب الكود أولا كما هو وأخبرنى هل يعمل أم لا
-
أخى الحبيب / أبو إيمان معادلة ممتازة تسلم ايديك
-
أخى الفاضل جرب هذه الطريقة لحذف كود معين داخل موديول Const Mod_Num = "Module2" Const Cod_Nam = "Test" Sub ragab() With ThisWorkbook.VBProject.VBComponents(Mod_Num).CodeModule .DeleteLines .ProcStartLine(Cod_Nam, 0), .ProcCountLines(Cod_Nam, 0) End With End Sub فى السطر الأول تحدد اسم الموديول الذى يحتوى على الكود Const Mod_Num = "Module2" فى السطر الثانى تحدد اسم الكود المراد حذفه Const Cod_Nam = "Test" وسوف تجد فى الملف المرفق مثال لذلك ملحوظة : لكى يعمل الكود بشكل سليم قم بعمل الأتى من محرر الأكواد اختار References من قائمة tools ثم ضع علامة صح أمام الإختيار Microsoft Visual Basic For Applications Extensibility حذف كود فقط.rar
-
أخى الفاضل بعد فتح الملف قم بادخال موديول جديد سيكون اسمه موديول module2 بشكل افتراضى لأن الملف يحتوى على module1 ثم احفظ الملف واغلقه ثم افتحه مره أخرى سوف تجد الموديول module2 تم حذفه
-
أستاذى الفاضل / محمد يوسف تفضل آخر بالمعادلات مصنف3.rar
-
وعليكم السلام ورحمة الله وبركاته أستاذى الفاضل محمد تفضل ما تريد عن طريق كود Sub ragab() Application.ScreenUpdating = False [E2:R30].ClearContents For i = 2 To 30 MyArr = Trim(Cells(i, 4)) For Each cl In [E1:R1] x = UBound(Filter(Split(MyArr, ","), cl)) + 1 If x > 0 Then Cells(i, cl.Column) = cl Next Next Application.ScreenUpdating = True End Sub مصنف2.rar
-
أخى الفاضل الملف الذى أرفقته أنت يعمل معى بشكل سليم
-
أخى الحبيب / أبو إيمان جزاك الله كل خير
-
أخى الفاضل / أبو حنين الكود يعمل معى بشكل سليم
-
بعد إذن أخى الفاضل أبو عيد أخى الفاضل أبو حنين إليك طريقة حذف موديول عند تاريخ محدد وهى كما يأتى ضع هذا الكود فى حدث الـ WORKBOOK Const Dat = #5/31/2014# Const mod_num = 1 Private Sub Workbook_Open() On Error Resume Next If Date >= Dat Then With ActiveWorkbook.VBProject.VBComponents .Remove .Item("Module" & mod_num) End With End If End Sub ومن السطر الأول فى الكود حدد التاريخ الذى تريده Const Dat = #5/31/2014# ومن السطر الثانى حدد رقم الموديول الذى تريد حذفه Const mod_num = 1 حذف موديول.rar
-
أخى الحبيب / محمد أبو البراء جزاك الله كل خير على هذا المرور العطر والكلمات الطيبة
-
أخى الفاضل / عبد الله جزاك الله كل خير
-
أخى الفاضل يجب ضغط الملف أولا ببرنامج ضغط مثل WINRAR ثم رفعه
-
السلام عليكم كل الشكر لإخوتى المشاركين ولاثراء الموضوع تفضل أخى Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = [B2].Address Then If [B2] = "MMM" Then [C2] = [C2] + 1 End If End Sub المصنف1.rar
-
السلام عليكم بعد كل الشكر لإخوتى الأفاضل المشاركين هذا كود آخر لاثراء الموضوع Sub ragab() Dim i As Integer Dim LR As Integer Dim cl As Range Dim arr() As Variant '========================================= Set WF = Application.WorksheetFunction LR = Cells(Rows.Count, 2).End(xlUp).Row '========================================= For Each cl In Range("B7:B" & LR) If Not IsEmpty(cl) Then i = i + 1 ReDim Preserve arr(1 To i) arr(i) = cl End If Next Range("D7:D" & LR).ClearContents Range("D7").Resize(i) = WF.Transpose(arr) Erase arr End Sub
-
أخى الحبيب / سليم تسلم ايديك
-
طلب المساعدة في ترحيل البيانات من الفورم إلى جدول
رجب جاويش replied to أب مارية's topic in منتدى الاكسيل Excel
السلام عليكم تفضل أخى table.rar