abouelhassan

جرب Sub نقل_البيانات() Dim ws As Worksheet Dim wsResult As Worksheet Dim lastRow As Long Dim i As Long ' افتح ورقة العمل الحالية Set ws = ThisWorkbook.Sheets("Sheet1") ' استبدل "Sheet1" باسم ورقة العمل الخاصة بك ' قم بإنشاء ورقة النتيجة إذا لم تكن موجودة بالفعل On Error Resume Next Set wsResult = ThisWorkbook.Sheets("النتيجة هنا") On Error GoTo 0 If wsResult Is Nothing Then Set wsResult = Sheets.Add(After:=Sheets(Sheets.Count)) wsResult.Name = "النتيجة هنا" End If ' حساب آخر صف غير فارغ في عمود F lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row ' نقل البيانات إلى ورقة النتيجة باستثناء الأسطر الفارغة في عمود F For i = 1 To lastRow If ws.Cells(i, "F").Value <> "" Then ws.Rows(i).Copy wsResult.Rows(wsResult.Cells(wsResult.Rows.Count, "A").End(xlUp).Row + 1) End If Next i MsgBox "تم نقل البيانات بنجاح!" End Sub

يمكننا ضبط الكود لتحقيق ذلك. يتم وضع كل اسم في خلية واحدة، والأسماء المختلفة تُفصل بواسطة سطر جديد في نفس الخلية. اليك الكود المعدل Private Sub Workbook_Open() ' جعل الصفحة من اليمين والتنسيق في المنتصف With ActiveWindow .WindowState = xlMaximized .DisplayRightToLeft = True End With ' تنسيق الأرقام بخط عريض بحجم 14 Cells.NumberFormat = "0" Cells.Font.Size = 14 ' تنسيق العمود A برقم مخصص 000000 Columns("A").NumberFormat = "000000" ' تنسيق العمود B بتكست Columns("B").NumberFormat = "@" ' تقسيم الأسماء في العمود C Dim lastRow As Long lastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To lastRow Dim fullNameA As String Dim fullNameB As String Dim combinedNames As String ' قراءة الأسماء من العمود A و B fullNameA = Cells(i, "A").Value fullNameB = Cells(i, "B").Value ' المقارنة والتحقق من الأسماء المتطابقة If InStr(fullNameB, fullNameA) > 0 Or InStr(fullNameA, fullNameB) > 0 Then combinedNames = fullNameA Else combinedNames = fullNameA & vbCrLf & fullNameB End If ' وضع الأسماء في العمود C Cells(i, "C").Value = combinedNames Next i End Sub

في الكود أدناه، يتم مقارنة الأسماء في العمود A والعمود B، وإذا كانت الأسماء متطابقة، يُكتب الاسم في العمود C، وإذا كانت مختلفة، يتم فصلها تمامًا في العمود 😄 Private Sub Workbook_Open() ' جعل الصفحة من اليمين والتنسيق في المنتصف With ActiveWindow .WindowState = xlMaximized .DisplayRightToLeft = True End With ' تنسيق الأرقام بخط عريض بحجم 14 Cells.NumberFormat = "0" Cells.Font.Size = 14 ' تنسيق العمود A برقم مخصص 000000 Columns("A").NumberFormat = "000000" ' تنسيق العمود B بتكست Columns("B").NumberFormat = "@" ' تقسيم الأسماء في العمود C Dim lastRow As Long lastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To lastRow Dim fullNameA As String Dim fullNameB As String ' قراءة الأسماء من العمود A و B fullNameA = Cells(i, "A").Value fullNameB = Cells(i, "B").Value ' المقارنة والفصل في العمود C If InStr(fullNameB, fullNameA) > 0 Or InStr(fullNameA, fullNameB) > 0 Then Cells(i, "C").Value = fullNameA Else Cells(i, "C").Value = fullNameA & " / " & fullNameB End If Next i End Sub

لإلغاء إدخال البيانات في عمود معين في Excel، يمكنك استخدام حماية الورقة وتحديد الخلايا التي تريد حمايتها. يمكنك اتباع الخطوات التالية: 1. افتح ورقة العمل في Excel. 2. حدد العمود الذي تريد حمايته (على سبيل المثال، عمود D). 3. انقر بزر الماوس الأيمن على العمود المحدد واختر "تنسيق الخلايا" (Format Cells). 4. انتقل إلى علامة التبويب "الحماية" (Protection). 5. حدد خيار "قفل الخلية" (Locked). ثم، اذهب إلى: 6. انقر بزر الماوس الأيمن على علامة التبويب "الورقة" (Sheet) في أسفل النافذة. 7. اختر "حماية الورقة" (Protect Sheet). 8. ادخل كلمة مرور إذا كنت ترغب في ذلك واختر الخيارات التي تناسب احتياجاتك. بعد الانتهاء من هذه الخطوات، ستكون البيانات في العمود D محمية ولن يمكن تعديلها إلا إذا تم إلغاء حماية الورقة باستخدام كلمة المرور التي قمت بتحديدها.

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

جرب Sub كتابة_الصدق_كل_20_صف() Dim صف As Integer Dim الصدق As String الصدق = "الصدق" ' تحديد صفوف للكتابة فيها For صف = 1 To ActiveSheet.Rows.Count Step 20 ' كتابة الكلمة في الخلية A في الصف الحالي Cells(صف, 1).Value = الصدق Next صف End Sub

جرب =SUMIFS(B:B, A:A, ">="&تاريخ_البداية, A:A, "<="&تاريخ_النهاية)

شكر وتقدير واحترام من اخيك

تسلم ايدك اخى استاذ محمد هشام. شكر وتقدير واحترام من اخيك

خالص الشكر استاذ محمد حسن المحمد اعزك الله احتاج كود لتنفيذ نظرا لكبر حجم الداتا بارك الله فيك واعزك اللهم امين يارب العالمين

السلام عليكم ورحمة الله اخوانى الافاضل كل عام وانتم بخير احتاج مساعدة بكود Vba للتجميع بدون تكرار لدينا شيتان الاول به ثلاث اعمدة الاسم والرقم القومى والمبلغ والشيت الثانى اسمه تجميع بدون تكرار احتاج كود للبحث فى عمود الرقم القومى اذا كان مكرر يجمع المبلغ بارك الله فيكم اخوانى الافاضل كود تجميع .xlsx

شكر وتقدير واحترام من اخيك

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

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

شكر وتقدير واحترام من اخيك

شكر وتقدير واحترام

شكر وتقدير واحترام من اخيك

شكر وتقدير واحترام

شكر وتقدير واحترام

متابع

شكر وتقدير واحترام من اخيك

الف الف مبروك

اخى الكريم مش عارف أطبق تصدير الجدول على قاعدة البيانات لدى شكر وتقدير واحترام من القلب

متابع

فتح الله عليك اخى ارجوا منك امدادنا ب مثال بحيث يتم الربط والتصدير للبيانات وإمكانية استيرادها بارك الله فيك اخي الكريم