Excel მაკროების მაგალითები დაწერილი VBA-ით

შემდეგი მარტივი Excel მაკრო მაგალითები დაიწერა VBA გამოყენებით 

კითხვის სავარაუდო დრო: 3 მინუტი

VBA მაგალითი Array-ის გამოყენებით

შემდეგი ქვე პროცედურა კითხულობს მნიშვნელობებს უჯრედებიდან აქტიური სამუშაო ფურცლის A სვეტში, სანამ არ შეხვდება ცარიელ უჯრედს. მნიშვნელობები ინახება მასივში. Excel-ის ეს მარტივი მაკრო მაგალითი ასახავს:

• ცვლადი დეკლარაციები;
• დინამიური მასივები;
• ციკლი Do Until;
• იხილეთ უჯრედები მიმდინარე Excel-ის სამუშაო ფურცელში;
• VBA ფუნქცია Ubound ჩაშენებული (რომელიც აბრუნებს მასივის უმაღლეს ინდექსს).

' 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 სვეტში.

ეს მაკრო ასახავს:

• ცვლადი დეკლარაციები;
• Excel-ის ობიექტები (კონკრეტულად, Set საკვანძო სიტყვის გამოყენება და წვდომა "Columns" ობიექტზე "Sheets" ობიექტიდან);
• ციკლი Do Until;
• წვდომა სამუშაო ფურცლებზე და უჯრედების დიაპაზონში მიმდინარე Excel სამუშაო წიგნში.

' 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 BasicVBA რედაქტორის გასახსნელად.
• VBA რედაქტორში ორჯერ დააწკაპუნეთ Sheet2-თან დაკავშირებულ კოდის რედაქტორზე.
• აირჩიეთ სამუშაო ფურცელი მარჯვენა (ან მარცხნივ) ჩანართიდან და აირჩიეთ შეცვლა.
• დაამატეთ 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