Saleh Ahmed Rabie

يوليو 11

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

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

يوليو 9

للرفع

يوليو 8

للرفع

يوليو 8

السلام عليكم ورحمة الله وبركاته

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

يرجى منكم التعاون لإستكمال الكود البرمجي حسب ماهو مطلوب.

عندنا عمود اضافة اسماء المعلمين
وعمود تكرارات الاسماء.

هل يمكن اضافة عمود ثالث بعد عمود تكرارات الاسماء
عمود التحكم في تكرار الاسماء بحيث يتم كتابة الارقام فيه يدوي
ويتم توزيع الاسماء حسب الارقام التي كتبت يدوية.

المطلوب يتم التوزيع حسب عدد النصاب لكل معلم.

اريد توزيع عشوائي حسب عدد النصاب لكل معلم

بشرط ان لا يكتب اسم معلم واحد مرتين في عمود اي لا يتكرر اسم متشابه مرتين في عمود.

مثلا: خالد وخالد لا اريد اسماء متشابهة في عمود

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

جدول الحصص2025.xls

يونيو 28

12 ساعات مضت, محمد زيدان2024 said:

المطلوب عمل كود ترتيب ابجدي للاسماء وعمل كود ترتيب تنازلي للمجموع @محمد هشام.

فرز.xlsb 571.92 kB · 3 downloads

**كود VBA لترتيب الأسماء أبجديًا**

Sub SortNamesAlphabetically()

    Dim rng As Range
    Dim lastRow As Long

    ' تحديد نطاق البيانات
    Set rng = Range("A1:A100") ' تعديل النطاق حسب الحاجة

    ' الحصول على آخر صف في النطاق
    lastRow = rng.Rows.Count

    ' فرز النطاق أبجديًا
    rng.Sort Key1:=rng.Columns(1), Order1:=xlAscending, Header:=xlYes

End Sub

**كود VBA لترتيب المجموع تنازليًا**

Sub SortSumDescending()

    Dim rng As Range
    Dim lastRow As Long

    ' تحديد نطاق البيانات
    Set rng = Range("A1:B100") ' تعديل النطاق حسب الحاجة

    ' الحصول على آخر صف في النطاق
    lastRow = rng.Rows.Count

    ' فرز النطاق تنازليًا حسب المجموع في العمود B
    rng.Sort Key1:=rng.Columns(2), Order1:=xlDescending, Header:=xlYes

End Sub

**ملاحظات:**

* تأكد من تعديل نطاقات البيانات في أكواد VBA لتتوافق مع نطاق بياناتك الفعلي.
* يمكنك استخدام هذه الأكواد لترتيب البيانات في أي نطاق من ورقة العمل.
* إذا كنت ترغب في فرز البيانات حسب معايير متعددة، يمكنك استخدام طريقة `Sort` مع معلمات `Key2` و`Order2` و`Key3` و`Order3` وما إلى ذلك.

يونيو 24

وعليكم السلام

Sub Logi1nNew_URL()
    Dim ie As Object
    Dim element As Object
    Dim str1 As String
    Dim str2 As String
    Dim str3 As String
    Dim lRow As Long
    
    ' Set Internet Explorer as default browser
    Set ie = CreateObject("Shell.Application").Windows("iexplore.exe")
    
    With Sheets("Sheet1")
        str1 = .Range("ac2").Value
        str2 = .Range("ad2").Value
        str3 = .Range("ae2").Value
    End With
    
    With ie
        .Visible = True
        .Navigate "http://student.moe.gov.eg/new/serch_students.aspx"
        
        Do Until .ReadyState = 4
            DoEvents
        Loop
        
        On Error Resume Next
        
        .Document.All.Item("ctl00$ContentPlaceHolder1$TextBox1").Value = str1
        .Document.All.Item("ctl00$ContentPlaceHolder1$TextBox2").Value = str2
        .Document.All.Item("ctl00$ContentPlaceHolder1$TextBox3").Value = str3
        
        For Each element In .Document.getElementsByTagName("input")
            If element.Type = "submit" Then
                element.Click
                Exit For
            End If
        Next element
    End With
End Sub

يونيو 22

10 دقائق مضت, pisces said:

السلام عليكم

ظهر لي نفس الخطأ

عند السطر
If Sheets(sheetName).Exists Then

وعليكم السلام

**ملاحظة:**
من المحتمل أن يكون سبب الخطأ هو أن اسم ورقة العمل `sheetName` غير صحيح أو غير موجود في المصنف.
* تأكد من استبدال `[Book1]Sheet1` في السطر `SubAddress:="'[Book1]Sheet1'!" & cell.Address` باسم ورقة العمل الحقيقية التي تحتوي على النطاق `cellAddress`.
* يمكنك أيضًا إضافة معالجة إضافية للتعامل مع الحالات الأخرى، مثل عندما تكون ورقة العمل أو النطاق محميًا أو مخفيًا.

يونيو 22

17 ساعات مضت, روضة محمد لطفى said:

إلى السادة الأفاضل خبراء الأكسيل بمنتداكم الموقر كل عام وأنتم بكل خير وسعادة وهناء

مرفق المطلوب بداخل الملف المرفق برجاء المساعدة من خلال المعادلات لسهولة استخراج الاحصاءات اللازمة

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

شيت الكنترول 2024.xlsx 22.76 kB · 4 downloads

**كود VBA لإظهار "راسب" للطلاب الذين لم يحصلوا على ربع درجة النجاح في الترم الثاني**

Sub CheckPassFail()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1") 'استبدل "Sheet1" باسم ورقة العمل الخاصة بك

    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    For i = 2 To lastRow
        If ws.Cells(i, "D").Value < 5 Then 'عمود الدرجات
            ws.Cells(i, "E").Value = "راسب" 'عمود النتيجة
        End If
    Next i

End Sub

**خطوات الاستخدام:**

1. انسخ الكود والصقه في وحدة نمطية في دفتر عمل Excel الخاص بك.
2. استبدل "Sheet1" في سطر `Set ws = ThisWorkbook.Worksheets("Sheet1")` باسم ورقة العمل التي تحتوي على بيانات الطلاب.
3. قم بتشغيل الكود بالنقر فوق الزر "تشغيل" في علامة التبويب "المطور" أو باستخدام اختصار لوحة المفاتيح `F5`.

**ملاحظات:**

* يفترض الكود أن عمود الدرجات هو العمود "D" وعمود النتيجة هو العمود "E".
* إذا لم يكن لديك عمود نتيجة، يمكنك إضافة واحد يدويًا أو تعديل الكود لتحديث عمود آخر.
* يمكنك تخصيص الكود لتناسب احتياجاتك المحددة، مثل تغيير قيمة درجة النجاح أو تغيير النص الذي يتم عرضه للطلاب الراسبين.

يونيو 22

5 ساعات مضت, spyhearts said:

السلام عليكم ورحمه الله وبركاته

كل عام وحضراتكم بخير

محتاج مساعدة في الملف المرفق فضلا وليس امرا

ولكم جزيل الشكر والتقدير

atf.xlsb 68.31 kB · 6 downloads

وعليكم السلام ورحمة الله وبركاته

**كود VBA لفصل محتوى الخلية إلى جزئين (الوصف والكود):**


Sub SplitCellContent()

    Dim rng As Range
    Dim arrContent() As String
    Dim strDescription As String
    Dim strCode As String

    ' تحديد الخلية التي تحتوي على المحتوى الذي تريد فصله
    Set rng = Range("A2")

    ' تقسيم المحتوى إلى مصفوفة من السلاسل
    arrContent = Split(rng.Value, " ")

    ' استخراج الوصف والكود من المصفوفة
    strDescription = arrContent(0)
    strCode = arrContent(1)

    ' وضع الوصف والكود في خلايا منفصلة
    rng.Offset(0, 1).Value = strDescription
    rng.Offset(0, 2).Value = strCode

End Sub

**مثال:**

إذا كان محتوى الخلية A2 هو:

جهاز كمبيوتر محمول HP EliteBook 840 G8

فسيؤدي تشغيل كود VBA هذا إلى فصل المحتوى إلى الخليتين B2 وC2 على النحو التالي:

* **B2:** جهاز كمبيوتر محمول HP EliteBook 840 G8
* **C2:** 840 G8

**ملاحظة:**

* يمكنك تعديل كود VBA لتناسب احتياجاتك الخاصة، مثل تغيير الخلية التي تحتوي على المحتوى أو تغيير الفاصل المستخدم لفصل الوصف والكود.
* يمكنك أيضًا استخدام كود VBA لفصل محتوى الخلية إلى أكثر من جزئين.

يونيو 22

4 ساعات مضت, pisces said:

السلام عليكم

اشكرك اخي العزيز saleh

ظهر لي المسج التالي
Subscript out of range

فضلاً وليس امراً إن كنت تستطيع تثبيتها في ملف سيكون افضل لي

**تحليل الخطأ:**

يحدث خطأ "Subscript out of range" عندما يحاول الكود الوصول إلى عنصر خارج نطاق المصفوفة أو المجموعة. في هذه الحالة، يبدو أن الخطأ يحدث في السطر التالي:

```

If Sheets(sheetName).Range(cellAddress) = "" Then

```

**الحل:**

من المحتمل أن يكون سبب الخطأ هو أن ورقة العمل `sheetName` لا تحتوي على نطاق `cellAddress`. للتحقق من ذلك، يمكنك إضافة سطرين للتحقق من وجود ورقة العمل والنطاق قبل محاولة الوصول إليهما.

**الكود المعدل:**

```
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    Dim formula As String, sheetName As String, cellAddress As String
    
    For Each cell In Target
        If InStr(cell.Formula, "=") > 0 Then
            formula = Mid(cell.Formula, InStr(cell.Formula, "=") + 1, Len(cell.Formula) - InStr(cell.Formula, "="))
            If InStr(formula, "!") > 0 Then
                sheetName = Mid(formula, 2, InStr(formula, "!") - 2)
                cellAddress = Mid(formula, InStr(formula, "!") + 1, Len(formula) - InStr(formula, "!"))
                If Sheets(sheetName).Exists Then
                    If Sheets(sheetName).Range(cellAddress).Exists Then
                        If Sheets(sheetName).Range(cellAddress) = "" Then
                            cell.Hyperlinks.Add Anchor:=cell, Address:="", SubAddress:="", TextToDisplay:=cell.Value
                        Else
                            Sheets(sheetName).Range(cellAddress).Hyperlinks.Add Anchor:=Sheets(sheetName).Range(cellAddress), Address:="", SubAddress:="'[Book1]Sheet1'!" & cell.Address, TextToDisplay:=Sheets(sheetName).Range(cellAddress).Value
                        End If
                    End If
                End If
            End If
        End If
    Next cell
End Sub
```

**ملاحظة:**

* تأكد من استبدال `[Book1]Sheet1` في السطر `SubAddress:="'[Book1]Sheet1'!" & cell.Address` باسم ورقة العمل الحقيقية التي تحتوي على النطاق `cellAddress`.
* يمكنك أيضًا إضافة معالجة إضافية للتعامل مع الحالات الأخرى، مثل عندما تكون ورقة العمل أو النطاق محميًا أو مخفيًا.

يونيو 21

يمكنك استخدام الكود التالي في VBA لإضافة الDynamic Hyperlink بين خليتين في شيتين مختلفين:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    Dim formula As String, sheetName As String, cellAddress As String
    
    For Each cell In Target
        If InStr(cell.Formula, "=") > 0 Then
            formula = Mid(cell.Formula, InStr(cell.Formula, "=") + 1, Len(cell.Formula) - InStr(cell.Formula, "="))
            If InStr(formula, "!") > 0 Then
                sheetName = Mid(formula, 2, InStr(formula, "!") - 2)
                cellAddress = Mid(formula, InStr(formula, "!") + 1, Len(formula) - InStr(formula, "!"))
                If Sheets(sheetName).Range(cellAddress) = "" Then
                    cell.Hyperlinks.Add Anchor:=cell, Address:="", SubAddress:="", TextToDisplay:=cell.Value
                Else
                    Sheets(sheetName).Range(cellAddress).Hyperlinks.Add Anchor:=Sheets(sheetName).Range(cellAddress), Address:="", SubAddress:="'[Book1]Sheet1'!" & cell.Address, TextToDisplay:=Sheets(sheetName).Range(cellAddress).Value
                End If
            End If
        End If
    Next cell
End Sub

```

يرجى استبدال "Book1" في الكود بعنوان المصنف الخاص بك.

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

يونيو 21

وللحماية من فتح ملفات Excel على الجوال يمكنك استخدام الكود التالي في VBA:

Private Sub Workbook_Open()
    If Application.OperatingSystem Like "*phone*" Then
        MsgBox "لا يمكن فتح هذا الملف على الهاتف الجوال", vbExclamation
        ThisWorkbook.Close SaveChanges:=False
    End If
End Sub

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

يمكنك إضافة هذا الكود في "ThisWorkbook" في محرر الفيجوال بيسيك لتطبيقه عند فتح الملف.

يونيو 21

كود VBA لحذف الشيتات المخفية في ملف Excel عند محاولة فتحها في الجوال وعدم حذفها عند فتحها في اللابتوب:

Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim deleteHiddenSheets As Boolean
    Dim operatingSystem As String
    operatingSystem = Application.OperatingSystem
    
    If operatingSystem Like "*phone*" Then
        deleteHiddenSheets = True
    Else
        deleteHiddenSheets = False
    End If

    If deleteHiddenSheets Then
        Application.DisplayAlerts = False
        For Each ws In ThisWorkbook.Sheets
            If ws.Visible = xlSheetHidden Then
                ws.Delete
            End If
        Next ws
        Application.DisplayAlerts = True
    End If
End Sub

يقوم هذه الكود بفحص نوع نظام التشغيل وفي حال كان النظام هو هاتف (جوال)، سيتم حذف جميع الشيتات المخفية. وإذا كان النظام ليس هاتف (مثل اللابتوب)، لن يتم حذف الشييتات المخفية. يمكنك استخدام هذا الكود في ملف Excel الخاص بك لتحقيق ذلك.

يونيو 21

ويمكنك استخدام الكود التالي لمنع فتح ملف Excel عبر الجوال وإخفاء جميع الأوراق في الملف:

Private Sub Workbook_Open()
    If Application.UserName = "اسم المستخدم هنا" And Application.OperatingSystem Like "*phone*" Then
        MsgBox "غير مسموح بفتح هذا الملف عبر الجوال", vbExclamation
        ThisWorkbook.Close False
    Else
        Dim ws As Worksheet
        For Each ws In ThisWorkbook.Sheets
            ws.Visible = xlSheetHidden
        Next ws
    End If
End Sub

يجب استبدال "اسم المستخدم هنا" بالاسم المستخدم الذي تريد منعه من فتح الملف عبر الجوال. يقوم الكود أولاً بالتحقق إذا كان المستخدم هو المستخدم المحدد وإذا كان نظام التشغيل هو الهاتف، سيتم عرض رسالة تنبيه وإغلاق الملف، وإلا سيتم إخفاء جميع الأوراق في الملف.

يونيو 21

**وعليكم السلام ورحمة الله وبركاته**

**كل عام وأنتم بخير وعافية**

**نعم، يوجد كود برمجي لمنع فتح ملف Excel بواسطة الهاتف المحمول.**

**إليك الكود:**

```


Private Sub Workbook_Open()
    If Application.Mobile Then
        MsgBox "Sorry, this workbook cannot be opened on a mobile device."
        Application.Quit
    End If
End Sub

```

**كيفية استخدام الكود:**

1. افتح ملف Excel الخاص بك.
2. انقر فوق علامة التبويب "المطور".
3. انقر فوق "Visual Basic" لفتح محرر Visual Basic.
4. انقر بزر الماوس الأيمن فوق اسم المصنف في الجزء الأيسر من المحرر.
5. انقر فوق "عرض التعليمات البرمجية".
6. الصق الكود في نافذة التعليمات البرمجية.
7. احفظ المصنف.

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

**ملاحظة:**

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

يونيو 12

2 ساعات مضت, abouelhassan said:

شكرا لك هذا غير مطلوب اخى

يونيو 12

=IF(A1>=0, ROUND(A1, 2), -ROUND(-

يونيو 11

2 ساعات مضت, Alaa Ammar New said:

السلام عليكم ورحمة الله وبركاته

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

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

جزاكم الله كل خير يا رب العالمين وزادكم بسطة في العلم والرزق والصحة آمين يا رب العالمين

2024 final.xlsm 246.98 kB · 1 download

وعليكم السلام ورحمة الله وبركاته

**إصلاح تاريخ معكوس عند التصدير إلى Word

* **استخدم تنسيق التاريخ المخصص:**
* في Excel، حدد الخلايا التي تحتوي على التاريخ.
* انقر بزر الماوس الأيمن واختر "تنسيق الخلايا".
* في علامة التبويب "الرقم"، حدد "مخصص" من القائمة المنسدلة "الفئة".
* أدخل تنسيق التاريخ المطلوب، على سبيل المثال: "dd/mm/yyyy".

* **استخدم دالة TEXT:**
* في Excel، أدخل الصيغة التالية في خلية فارغة:
```

=TEXT(A1, "dd/mm/yyyy")

```
حيث A1 هي الخلية التي تحتوي على التاريخ المعكوس.* **استخدم ماكرو:**
* يمكنك إنشاء ماكرو لتصحيح التاريخ المعكوس عند التصدير إلى Word.
* افتح محرر Visual Basic (Alt + F11).
* انقر على "إدراج" > "وحدة نمطية".
* الصق الكود التالي في وحدة النمط:
```

Sub FixReversedDates()
    Dim rng As Range
    Dim cell As Range

    Set rng = Selection

    For Each ce=TEXT(A1, "dd/mm/yyyy")ll In rng
        If cell.NumberFormat = "@" Then
            cell.Value = DateValue(cell.Value)
        End If
    Next cell
  End Sub

```

يونيو 11

وعليكم السلام ورحمة الله وبركاته

لحل هذه المشكلة، يمكنك استخدام الدالة `ABS` جنبًا إلى جنب مع دالة التقريب. تعمل دالة `ABS` على إرجاع القيمة المطلقة لرقم، مما يحول الأرقام السالبة إلى أرقام موجبة.

**الصيغة المعدلة**

=ROUND(ABS(A1), 2)

حيث:

* `A1` هو الخلية التي تحتوي على الرقم الذي تريد تقريبه.
* `2` هو عدد المنازل العشرية التي تريد تقريب الرقم إليها.

**مثال**

لنفترض أن لديك جدول رواتب في ورقة عمل Excel وتريد تقريب رواتب الموظفين إلى أقرب دولار. تحتوي الخلية `A1` على راتب موظف بقيمة -123.45 دولارًا.

باستخدام الصيغة المعدلة، يمكنك تقريب الراتب على النحو التالي:

=ROUND(ABS(A1), 2)

ستعيد هذه الصيغة القيمة 123.45 دولارًا، وهي القيمة المطلقة للراتب الأصلي مقربة إلى أقرب دولار.

**ملاحظة**

إذا كنت ترغب في تقريب الأرقام السالبة إلى أقرب قيمة سالبة، يمكنك استخدام الصيغة التالية:

=-ROUND(ABS(A1), 2)

يونيو 11

وعليكم السلام ورحمة الله وبركاته

يمكنك استخدام الكود التالي لنسخ البيانات من الجدول D6:K400 ووضعها في العمود M6:M400 في الورقة الحالية:```

Sub CopyData()
    Dim ws As Worksheet
    Dim i As Integer
    
    Set ws = ThisWorkbook.Sheets("ورقة١")

    For i = 6 To 400
        ws.Range("M" & i).Value = ws.Range("D" & i).Value
        ws.Range("M" & i + 1 & ":M" & i + 7).Value = Application.Transpose(ws.Range("E" & i & ":K" & i).Value)
    Next i
End Sub

يرجى استبدال "ورقة١" باسم الورقة التي تريد نقل البيانات إليها. يمكنك تشغيل الكود عن طريق الذهاب إلى عارض VBA والنقر بزر الماوس الأيمن على اسم الورقة ثم اختيار "Insert" ثم "Module" ولصق الكود في نافذة الكود الجديدة ومن ثم تشغيله.

ستقوم هذه العملية بنسخ البيانات من الجدول D6:K400 ووضعها في العمود M6:M400 في الورقة المحددة.

يونيو 10

3 دقائق مضت, ahmed sewelam said:

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

يونيو 10

38 دقائق مضت, ahmed sewelam said:

للاسف لم يقم الكود بعمل المطلوب حيث تم تغيير الكود لكن تظهر شاشة ادخال اسم الملف والمطلوب انه يحفظ تلقائي الملف باسم الموظف كما بالخلية B8 داخل الفولدر

ملف3.xls ملف2.xlsm

يونيو 10

13 دقائق مضت, ahmed sewelam said:

ماش شاء الله بارك الله في عمرك مجهود جبار

تعديل اخير هل بالامكان تعديل بالكود بحيث اسم الملف يكون باسم الموظف مباشرة كما بالخلية B8

بدل من ظهور شاشة وكتابة اسم الملف

تأكد ان يكون لكل مستخدم اسمه محفوظ في الـ cell B8 ، فهذا الاسم سيتم حفظه مع الملف الـ PDF ككود. يجب تغيير السطر التالي:

FileName = Dir(FilePath)

إلى:

FileName = Range("B8").Value

هذا الكود سيجعل اسم الملف الـ PDF يأخذ قيمة الـ cell B8 مباشرة كاسم للموظف.

يونيو 10

7 دقائق مضت, abouelhassan said:

اولا اشكرك اخي

الكود. يعطى خطأ

والله اخى جربت اكواد كثيرة جدااااا ولم تعمل

لذا كتبت الموضوع عسى يمدنا اخونا بكود يعمل

بارك الله فى الجميع

إليك مثال بسيط لاستخدام الكود:

1. افتح برنامج الإكسل وانشئ ورقة عمل جديدة.
2. قم بنسخ ولصق البيانات التالية في الخلايا من D2 إلى D4:

```
123
456.78
1,234.56
```

3. انسخ والصق الكود التالي في المحرر النصي لـ VBA:

Sub ConvertTextToNumber()
    Dim cell As Range
    For Each cell In Range("D2:D4")
        If IsNumeric(cell.Value) Then
            cell.Value = Val(cell.Value)
        Else
            cell.Value = Val(Replace(cell.Value, ",", ""))
        End If
    Next cell
End Sub

4. اضغط على زر التشغيل أو اختر "Run" من القائمة لتشغيل الكود.
5. ستلاحظ أن الأرقام في الخلايا D2 و D3 تم تحويلها من النص إلى أرقام، في حين تمت معالجة الفاصلة في الرقم D4 وتحويله إلى رقم أيضًا.

هذا المثال يوضح كيف يمكنك استخدام الكود لتحويل الأرقام من النص إلى أرقام في Excel.

يونيو 10

33 دقائق مضت, كمال على طارق said:
وعليكم السلام-بعد اذن طبعا أستاذنا الكبير صلاح -يمكنك استخدام أيضاً هذه المعادلة
=DATEDIF($D2,TODAY(),"y")&"Years, " &DATEDIF($D2,TODAY(),"YM")&"Months, "&TODAY()-DATE(YEAR(TODAY()),MONTH(TODAY()),1)&"Days"
مسودة1.xlsx 14.09 kB · 1 download

ويمكنك استخدام الكود التالي في VBA للحصول على نفس النتيجة في جميع إصدارات Excel:

Function DateDifference(startDate As Date) As String
    Dim years As Integer
    Dim months As Integer
    Dim days As Integer
    
    years = DateDiff("yyyy", startDate, Date)
    months = DateDiff("m", startDate, Date) Mod 12
    days = DateDiff("d", startDate, Date) - Int(DateDiff("d", startDate, Date) / 30) * 30
    
    DateDifference = years & " Years, " & months & " Months, " & days & " Days"
End Function

يمكنك استدعاء هذه الوظيفة في Excel باستخدام الصيغة: =DateDifference($D2)

هذا الكود يعمل في جميع إصدارات Excel.

تسجيل الدخول

المنتدى

مكتبة الموقع

معرض الصور

المدونات

الوسائط المتعددة

مشاركات المكتوبه بواسطه Saleh Ahmed Rabie

Important Information