أمثلة VBA | قائمة بأفضل 19 مثالاً على برنامج Excel VBA للمبتدئين
أمثلة على برنامج Excel VBA للمبتدئين
تعد وحدات الماكرو أفضل صديق لك عندما يتعلق الأمر بزيادة إنتاجيتك أو توفير بعض الوقت في مكان عملك. من المهام الصغيرة إلى المهام الكبيرة ، يمكننا أتمتة باستخدام لغة ترميز VBA. أعلم أنه في كثير من الأحيان ربما تكون قد فكرت في بعض القيود التي يفرضها برنامج Excel ولكن مع ترميز VBA ، يمكنك التخلص من كل هذه القيود. حسنًا ، إذا كنت تكافح مع VBA وما زلت مبتدئًا في هذه المقالة ، فسنقدم بعض الأمثلة المفيدة لرمز VBA Macro في Excel.
قائمة أفضل 19 مثالاً
- طباعة كافة أسماء الأوراق
- أدخل فهرس لون مختلف في VBA
- أدخل الرقم التسلسلي من الأعلى
- أدخل الرقم التسلسلي من الأسفل
- أدخل الرقم التسلسلي من 10 إلى 1
- أدخل أوراق العمل بقدر ما تريد
- احذف جميع أوراق العمل الفارغة من المصنف
- أدخل صفًا فارغًا بعد كل صف آخر
- قم بتمييز الخطأ الإملائي
- تغيير الكل إلى أحرف كبيرة
- تغيير الكل إلى أحرف صغيرة
- قم بتمييز كل الخلايا المعلقة
- قم بتمييز كل الخلايا الفارغة
- إخفاء كل الأوراق باستثناء ورقة واحدة
- إظهار كافة الأوراق
- حذف كافة الملفات الموجودة في المجلد
- حذف المجلد بأكمله
- ابحث عن آخر صف تم استخدامه في الورقة
- ابحث عن آخر عمود تم استخدامه في الورقة
دعونا نرى كل من هذا المثال بالتفصيل.
يمكنك تنزيل نموذج Excel لأمثلة VBA من هنا - أمثلة VBA قالب Excel# 1 - طباعة جميع أسماء الأوراق
رمز:
Sub Print_Sheet_Names () Dim i As Integer For i = 1 To Sheets.Count Cells (i، 1) .Value = Sheets (i). Name Next i End Sub
سيؤدي هذا إلى استخراج جميع أسماء الأوراق إلى الورقة النشطة.
# 2 - أدخل فهرس لون مختلف في VBA
رمز:
Sub Insert_Different_Colours () Dim i As Integer For i = 1 إلى 56 Cells (i، 1) .Value = i Cells (i، 2) .In interior.ColorIndex = i Next End Sub
سيؤدي ذلك إلى إدراج الأرقام من 1 إلى 56 وفهرس الألوان في العمود التالي.
# 3 - أدخل الرقم التسلسلي من الأعلى
رمز:
فرعي Insert_Numbers_From_Top () Dim i As Integer For i = 1 إلى 10 Cells (i، 1) .Value = i Next i End Sub
سيؤدي هذا إلى إدخال الأرقام التسلسلية من 1 إلى 10 من الأعلى.
# 4 - أدخل الرقم التسلسلي من الأسفل
رمز:
Sub Insert_Numbers_From_Bottom () Dim i As Integer For i = 20 To 1 Step -1 Cells (i، 7) .Value = i Next i End Sub
سيؤدي هذا إلى إدخال الأرقام التسلسلية من 1 إلى 20 من الأسفل.
# 5 - أدخل الرقم التسلسلي من 10 إلى 1
رمز:
Sub Ten_To_One () Dim i As Integer Dim j As Integer j = 10 For i = 1 To 10 Range ("A" & i) .Value = jj = j - 1 Next i End Sub
سيؤدي هذا إلى إدخال الأرقام التسلسلية من 10 إلى 1 من الأعلى.
# 6 - أدخل أوراق العمل بقدر ما تريد
رمز:
Sub AddSheets () Dim ShtCount As Integer، i As Integer ShtCount = Application.InputBox ("كم عدد الأوراق التي تريد إدراجها؟" ، "إضافة أوراق" ، ، ، ، ، ، ، 1) إذا كان ShtCount = False ، فقم بالخروج من الجزء الفرعي آخر بالنسبة إلى i = 1 إلى أوراق عمل ShtCount. أضف التالي i End If End Sub
سيطلب منك هذا إدخال عدد أوراق العمل التي ترغب في إدراجها. ما عليك سوى تحديد الرقم في مربع الإدخال والنقر فوق "موافق" ، سيتم إدراج تلك الأوراق العديدة على الفور.
# 7 - احذف جميع أوراق العمل الفارغة من المصنف
رمز:
Sub Delete_Blank_Sheets () Dim ws As Worksheet Application.DisplayAlerts = False Application.ScreenUpdating = False For each ws In ActiveWorkbook.Worksheets If WorksheetFunction.CountA (ws.UsedRange) = 0 ثم ws.Delete End If Next ws Application.DisplayAlerts = True Application.DisplayAlerts = True Application. .ScreenUpdating = True End Sub
سيؤدي هذا إلى حذف جميع أوراق العمل الفارغة من المصنف الذي نعمل عليه.
# 8 - أدخل صفًا فارغًا بعد كل صف آخر
رمز:
فرعي Insert_Row_After_Every_Other_Row () Dim rng كنطاق عد خافت بصف كعدد صحيح Dim i As Integer Set rng = Selection CountRow = rng.EntireRow.Count For i = 1 To CountRow ActiveCell.EntireRow.Insert ActiveCell.Offset (2، 0). End Sub
لهذا أولاً ، تحتاج إلى تحديد النطاق الذي ترغب في إدراج صفوف فارغة بديلة فيه.
# 9 - إبراز الخطأ الإملائي
رمز:
Sub Chech_Spelling_Mistake () Dim MySelection كمدى لكل MySelection في ActiveSheet.UsedRange If Not Application.CheckSpelling (Word: = MySelection.Text) ثم MySelection.Interior.Color = vbRed End إذا التالي MySelection End Sub
أولاً ، حدد البيانات وقم بتشغيل رمز VBA. سوف يسلط الضوء على الخلايا التي بها أخطاء إملائية.
# 10 - تغيير الكل إلى أحرف كبيرة
رمز:
Sub Change_All_To_UPPER_Case () Dim Rng كنطاق لكل Rng في التحديد.
أولاً ، حدد البيانات وقم بتشغيل الكود. سيتم تحويل جميع القيم النصية إلى أحرف كبيرة.
# 11 - تغيير الكل إلى أحرف صغيرة
رمز:
Sub Change_All_To_LOWER_Case () Dim Rng كنطاق لكل Rng في التحديد. Cells If Rng.HasFormula = False ثم Rng.Value = LCase (Rng.Value) End If Next Rng End Sub
أولاً ، حدد البيانات وقم بتشغيل الكود. سيتم تحويل جميع القيم النصية إلى أحرف صغيرة في Excel.
# 12 - قم بتمييز جميع الخلايا المعلقة
رمز:
Sub HighlightCellsWithCommentsInActiveWorksheet () ActiveSheet.UsedRange.SpecialCells (xlCellTypeComments) .Interior.ColorIndex = 4 End Sub
نتيجة:
# 13 - قم بتمييز جميع الخلايا الفارغة
رمز:
Sub Highlight_Blank_Cells () Dim DataSet as Range Set DataSet = Selection DataSet.Cells.SpecialCells (xlCellTypeBlanks) .Interior.Color = vbGreen End Sub
أولاً ، حدد نطاق البيانات وقم بتشغيل الكود. سيبرز كل الخلايا الفارغة باللون الأخضر.
# 14 - إخفاء كل الأوراق باستثناء ورقة واحدة
رمز:
Sub Hide_All_Except_One () Dim Ws كأوراق عمل لكل Ws في ActiveWorkbook.Worksheets If Ws.Name "Main Sheet" ثم Ws.Visible = xlSheetVeryHidden Next Ws End Sub
يخفي الكود أعلاه جميع الأوراق باستثناء الورقة المسماة "الورقة الرئيسية". يمكنك تغيير اسم ورقة العمل حسب رغبتك.
# 15 - إظهار كافة الأوراق
رمز:
Sub UnHide_All () Dim Ws كورقة عمل لكل Ws في ActiveWorkbook.Worksheets Ws.Visible = xlSheetVisible التالي Ws End Sub
سيؤدي هذا إلى إظهار جميع الأوراق المخفية.
# 16 - احذف جميع الملفات في المجلد
رمز:
Sub Delete_All_Files () 'يمكنك استخدام هذا لحذف جميع الملفات الموجودة في المجلد اختبار' 'On Error Resume Next Kill "C: \ Users \ Admin_2.Dell-Pc \ Desktop \ Delete Folder \ *. *. End Sub
قم بتغيير مسار المجلد المحدد باللون الأحمر حسب حذف المجلد الخاص بك.
# 17 - حذف المجلد بأكمله
رمز:
Sub Delete_Whole_Folder () 'يمكنك استخدام هذا لحذف المجلد بأكمله. ثم سيحذف الرمز أدناه المجلد بأكمله إذا كان فارغًا RmDir "C: \ Users \ Admin_2.Dell-Pc \ Desktop \ Delete Folder \" "" ملاحظة: RmDir يحذف مجلدًا فارغًا فقط عند الخطأ GoTo 0 End Sub
قم بتغيير مسار المجلد المحدد باللون الأحمر حسب حذف المجلد الخاص بك.
# 18 - ابحث عن آخر صف مستخدم في الورقة
رمز:
Sub Last_Row () Dim LR As Long LR = الخلايا (Rows.Count، 1) .End (xlUp) .Row MsgBox LR End Sub
هنا نجد آخر صف مستخدم في الورقة
# 19 - ابحث عن آخر عمود مستخدم في الورقة
رمز:
Last_Column () Dim LC طويل LC = خلايا (1، Columns.Count). End (xlToLeft) .Column MsgBox LC End Sub
هنا نجد العمود الأخير المستخدم في الورقة
