۱۰ کد رایگان برتر ماکرو VBA برای اکسل: راه‌حل‌های خلاقانه برای برنامه‌نویسان مبتدی تا حرفه‌ای

در زير ده کد رایگان برتر ماکرو VBA در اکسل  ارائه مي شود

عناوین کدها:

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

کد مرتب‌سازی داده‌های یک ستون

کد فیلتر کردن داده‌ها به صورت خودکار

کد ارسال خودکار ایمیل با استفاده از اطلاعات اکسل

کد محاسبه میانگین و نمایش آن در یک سلول

کد وارد کردن داده‌ها از یک فایل متنی

کد ترسیم نمودار به صورت خودکار

کد پاک‌سازی داده‌های تکراری

کد ذخیره Sheet به عنوان PDF

کد بررسی و علامت‌گذاری خطاها در داده‌ها

 

توضيحات كدها:

 1. کد ایجاد یک جدول با محدوده دلخواه ردیف و ستون

 

   Sub CreateTable()

       Dim ws As Worksheet

       Set ws = ThisWorkbook.Sheets("Sheet1")

       ws.ListObjects.Add(xlSrcRange, ws.Range("A1:D10"), , xlYes).Name = "MyTable"

   End Sub

 

   توضیحات: این کد یک جدول جدید در برگه "Sheet1" با دامنه مشخص ایجاد می‌کند.

2. کد برای مرتب‌سازی داده‌ها بر اساس یک ستون

  

   Sub SortData()

       Dim ws As Worksheet

       Set ws = ThisWorkbook.Sheets("Sheet1")

       ws.Sort.SortFields.Clear

       ws.Sort.SortFields.Add Key:=ws.Range("A2:A10"), Order:=xlAscending

       ws.Sort.SetRange ws.Range("A1:D10")

       ws.Sort.Apply

   End Sub

  

   توضیحات: این کد داده‌ها را بر اساس ستون A مرتب می‌کند.

 

3. کد برای فیلتر کردن داده‌ها به صورت خودکار

   Sub FilterData()

       Dim ws As Worksheet

       Set ws = ThisWorkbook.Sheets("Sheet1")

       ws.Range("A1:D10").AutoFilter Field:=1, Criteria1:="Criteria"

   End Sub

 

   توضیحات: این کد داده‌ها را بر اساس معیار مشخص شده فیلتر می‌کند.

 

4. کد برای ارسال خودکار ایمیل با استفاده از اطلاعات اکسل

  

   Sub SendEmail()

       Dim OutlookApp As Object

       Dim OutlookMail As Object

       Set OutlookApp = CreateObject("Outlook.Application")

       Set OutlookMail = OutlookApp.CreateItem(0)

       With OutlookMail

           .To = "receiver@example.com"

           .Subject = "Subject"

           .Body = "Body content"

           .Send

       End With

   End Sub

     توضیحات: این کد یک ایمیل با مشخصات معین ارسال می‌کند.

 

5. کد برای محاسبه میانگین و نمایش آن در یک سلول

  

   Sub CalculateAverage()

       Dim avgVal As Double

       avgVal = Application.WorksheetFunction.Average(ThisWorkbook.Sheets("Sheet1").Range("A1:A10"))

       ThisWorkbook.Sheets("Sheet1").Range("B1").Value = avgVal

   End Sub

   توضیحات: این کد میانگین داده‌های A1 تا A10 را محاسبه و در سلول B1 نمایش می‌دهد.

 

6. کد برای وارد کردن داده‌ها از یک فایل متنی

   Sub ImportTextFile()

       With ThisWorkbook.Sheets("Sheet1").QueryTables.Add(Connection:="TEXT;C:\path\to\file.txt", Destination:=Range("A1"))

           .TextFileConsecutiveDelimiter = False

           .TextFileTabDelimiter = True

           .Refresh

       End With

   End Sub

   

   توضیحات: این کد داده‌ها را از یک فایل متنی وارد می‌کند.

 

7. کد برای ایجاد نمودار به صورت خودکار

 

   Sub CreateChart()

       Dim ws As Worksheet

       Set ws = ThisWorkbook.Sheets("Sheet1")

       Dim chartObj As ChartObject

       Set chartObj = ws.ChartObjects.Add(Left:=100, Width:=375, Top:=50, Height:=225)

       With chartObj.Chart

           .SetSourceData Source:=ws.Range("A1:B10")

           .ChartType = xlColumnClustered

       End With

   End Sub

   توضیحات: این کد یک نمودار ستونی با داده‌های مشخص ایجاد می‌کند.

 

8. کد برای پاک‌سازی داده‌های تکراری

   Sub RemoveDuplicates()

       ThisWorkbook.Sheets("Sheet1").Range("A1:A100").RemoveDuplicates Columns:=1, Header:=xlYes

   End Sub

   توضیحات: این کد داده‌های تکراری را در ستون A حذف می‌کند.

 

9. کد برای ذخیره Sheet به عنوان PDF

   Sub SaveAsPDF()

       ThisWorkbook.Sheets("Sheet1").ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\path\to\file.pdf"

   End Sub

   توضیحات: این کد برگه "Sheet1" را به عنوان فایل PDF ذخیره می‌کند.

 

10. کد برای بررسی و علامت‌گذاری خطاها در داده‌ها

    Sub CheckErrors()

        Dim ws As Worksheet

        Set ws = ThisWorkbook.Sheets("Sheet1")

        Dim cell As Range

        For Each cell In ws.Range("A1:A10")

            If IsError(cell.Value) Then

                cell.Interior.Color = RGB(255, 0, 0) ' رنگ قرمز برای خطاها

            End If

        Next cell

    End Sub

    توضیحات: این کد سلول‌های دارای خطا را با رنگ قرمز علامت‌گذاری می‌کند