در زير ده کد رایگان برتر ماکرو 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
توضیحات: این کد سلولهای دارای خطا را با رنگ قرمز علامتگذاری میکند