مقالات

نمونه هایی از ماکروهای Excel نوشته شده با VBA

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

زمان تخمینی مطالعه: 3 minuti

مثال VBA با استفاده از Array

رویه زیر زیر مقادیر را از سلول‌های ستون A صفحه کاری فعال می‌خواند تا زمانی که با یک سلول خالی مواجه شود. مقادیر در یک آرایه ذخیره می شوند. این مثال ساده ماکرو اکسل استفاده از موارد زیر را نشان می دهد:

  • اعلامیه های متغیر؛
  • آرایه های پویا؛
  • یک چرخه Do Until;
  • به سلول های کاربرگ فعلی اکسل مراجعه کنید.
  • تابع VBA Ubound buildin (که بالاترین شاخص یک آرایه را برمی گرداند).
' Sub procedure store values in Column A of the active Worksheet
' into an array
Sub GetCellValues()
Dim iRow As Integer            ' stores the current row number
Dim dCellValues() As Double  ' array to store the cell values
iRow = 1
ReDim dCellValues(1 To 10)
' Do Until loop to extract the value of each cell in column A
' of the active Worksheet, as long as the cell is not blank
Do Until IsEmpty(Cells(iRow, 1))
   ' Check that the dCellValues array is big enough
   ' If not, use ReDim to increase the size of the array by 10
   If UBound(dCellValues) < iRow Then
      ReDim Preserve dCellValues(1 To iRow + 9)
   End If
   ' Store the current cell in the CellValues array
   dCellValues(iRow) = Cells(iRow, 1).Value
   iRow = iRow + 1
Loop
End Sub

این رویه مقادیر ستون A از کاربرگ فعال را در یک آرایه ذخیره می کند، توجه داشته باشید که:

  • چرخه Do Until مقادیر هر سلول را در ستون A از کاربرگ فعال استخراج می کند و سلول های خالی را نادیده می گیرد.
  • شرایط "If UBound(dCellValues) < iRow” بررسی می کند که آرایه dCellValues ​​به اندازه کافی بزرگ است که اطلاعات را در خود نگه دارد، اگر نه، از ReDim برای افزایش اندازه آرایه تا 10 استفاده کنید.
  • بالاخره آموزش​​dCellValues(iRow) = Cells(iRow, 1).Value” سلول فعلی را در آرایه CellValues ​​ذخیره می کند

مثال VBA با عملیات ریاضی

رویه زیر زیر مقادیر ستون A صفحه کاری با نام Sheet2 را می خواند و عملیات حسابی روی مقادیر انجام می دهد. مقادیر به دست آمده در ستون A از کاربرگ فعال فعلی چاپ می شود.

این ماکرو نشان می دهد:

خبرنامه نوآوری
مهم ترین اخبار نوآوری را از دست ندهید. برای دریافت آنها از طریق ایمیل ثبت نام کنید.
  • اعلامیه های متغیر؛
  • اشیاء اکسل (به طور خاص، استفاده از کلمه کلیدی Set و نحوه دسترسی به شی "Columns" از شی "Sheets").
  • یک چرخه Do Until;
  • به کاربرگ‌ها و محدوده‌های سلولی در کتاب کار فعلی اکسل دسترسی داشته باشید.
' Sub procedure to loop through the values in Column A of the Worksheet
' "Sheet2", perform arithmetic operations on each value, and write the
' result into Column A of the current Active Worksheet ("Sheet1")
Sub Transfer_ColA()
Dim i As Integer
Dim Col As Range
Dim dVal As Double
' Set the variable 'Col' to be Column A of Sheet 2
Set Col = Sheets("Sheet2").Columns("A")
i = 1
' Loop through each cell of the column 'Col' until
' a blank cell is encountered
Do Until IsEmpty(Col.Cells(i))
   ' Apply arithmetic operations to the value of the current cell
   dVal = Col.Cells(i).Value * 2 + 1
   ' The command below copies the result into Column A
   ' of the current Active Worksheet - no need to specify
   ' the Worksheet name as it is the active Worksheet.
   Cells(i, 1) = dVal
   i = i + 1
Loop
End Sub

مثال VBA با ضبط تاریخ اصلاح

بیایید یک ماکرو VBA ساده بنویسیم که وقتی سلولی در محدوده خاصی از برگه ما به روز می شود فعال می شود. فرض کنید می خواهید تغییرات ستون B (B4 تا B11) را دنبال کنید و تاریخ و زمان تغییر را در ستون A ثبت کنید.
بیایید اینگونه پیش برویم:

  • در برگه Developer روی گزینه "کلیک کنیدVisual Basic” برای باز کردن ویرایشگر VBA.
  • در ویرایشگر VBA، روی ویرایشگر کد مربوط به Sheet2 دوبار کلیک کنید.
  • از برگه سمت راست (یا چپ) Worksheet را انتخاب کرده و گزینه Change را انتخاب کنید.
  • اضافه کردن کد VBA:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B1:B10")) Is Nothing Then
        Target.Range("A1:A1").Value = Now
    End If
End Sub

کتاب کار را با فعال بودن ماکروها (مثلاً به عنوان یک فایل xlsm.) ذخیره کنید.


اکنون، هر بار که سلولی را در ستون B به روز می کنیم (از ردیف 1 تا ردیف 10)، سلول ستون A به طور خودکار تاریخ و زمان فعلی را نمایش می دهد.

Ercole Palmeri

خبرنامه نوآوری
مهم ترین اخبار نوآوری را از دست ندهید. برای دریافت آنها از طریق ایمیل ثبت نام کنید.

مقالات اخیر

Veeam دارای جامع ترین پشتیبانی از باج افزار، از محافظت تا پاسخ و بازیابی است

Coveware توسط Veeam به ارائه خدمات پاسخگویی به حوادث اخاذی سایبری ادامه خواهد داد. Coveware قابلیت‌های پزشکی قانونی و اصلاحی را ارائه می‌دهد…

آوریل 23 2024

انقلاب سبز و دیجیتال: چگونه تعمیر و نگهداری پیش‌بینی‌کننده صنعت نفت و گاز را متحول می‌کند

تعمیر و نگهداری پیش بینی شده با رویکردی نوآورانه و پیشگیرانه برای مدیریت کارخانه، بخش نفت و گاز را متحول می کند.…

آوریل 22 2024

تنظیم کننده ضد انحصار بریتانیا هشدار BigTech را در مورد GenAI به صدا در می آورد

CMA انگلستان در مورد رفتار Big Tech در بازار هوش مصنوعی هشداری صادر کرده است. آنجا…

آوریل 18 2024

کاسا گرین: انقلاب انرژی برای آینده ای پایدار در ایتالیا

فرمان "خانه های سبز" که توسط اتحادیه اروپا برای افزایش بهره وری انرژی ساختمان ها تدوین شده است، روند قانونی خود را با…

آوریل 18 2024

نوآوری را به زبان خود بخوانید

خبرنامه نوآوری
مهم ترین اخبار نوآوری را از دست ندهید. برای دریافت آنها از طریق ایمیل ثبت نام کنید.

ما را دنبال کنید