Egzanp Macro Excel ekri ak VBA

Egzanp macro senp Excel sa yo te ekri lè l sèvi avèk VBA 

Estimasyon tan lekti: 3 minit

Egzanp VBA lè l sèvi avèk Array

Pwosedi Sub sa a li valè ki soti nan selil nan kolòn A nan fèy travay la aktif, jiskaske li rankontre yon selil vid. Valè yo estoke nan yon etalaj. Egzanp makro Excel senp sa a montre itilizasyon:

• Deklarasyon varyab;
• etalaj dinamik;
• Yon sik Do Until;
• Gade nan selil ki nan fèy travay Excel aktyèl la;
• Fonksyon VBA Ubound builtin (ki retounen endèks ki pi wo nan yon etalaj).

' 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

Pwosedi a estoke valè yo nan kolòn A nan fèy travay la aktif nan yon etalaj, sonje ke:

• Sik la Do Until Ekstrè valè yo nan chak selil nan kolòn A nan fèy travay la aktif, inyore selil vid yo
• Kondisyon an"If UBound(dCellValues) < iRow” tcheke si etalaj dCellValues ​​la gwo ase pou kenbe enfòmasyon an, si se pa sa, sèvi ak ReDim pou ogmante gwosè etalaj la pa 10.
• Finalman, edikasyon​​dCellValues(iRow) = Cells(iRow, 1).Value” Sere selil aktyèl la nan etalaj CellValues ​​la

Egzanp VBA ak operasyon matematik

Pwosedi Sub sa a li valè ki soti nan kolòn A nan fèy travay ki rele "Sheet2" epi li fè operasyon aritmetik sou valè yo. Valè ki kapab lakòz yo enprime nan kolòn A nan fèy travay aktyèl la.

Makro sa a montre:

• Deklarasyon varyab;
• Objè Excel (espesyalman, sèvi ak mo kle Set la ak fason pou jwenn aksè nan objè 'Kolòn' nan objè 'Fèy' yo);
• Yon sik Do Until;
• Aksè fichye ak seri selil yo nan liv travay Excel aktyèl la.

' 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

Egzanp VBA ak anrejistreman dat modifikasyon

Ann ekri yon makro VBA senp ki tire lè yon selil nan yon seri espesifik nan fèy nou an mete ajou. Sipoze ou vle swiv chanjman nan kolòn B (B4 a B11) epi anrejistre dat ak lè chanjman nan kolòn A.
Ann kontinye konsa:

• Nan tab la Developer klike sou opsyon "Visual Basic” pou louvri editè VBA a.
• Nan editè VBA a, double-klike sou editè kòd ki gen rapò ak Sheet2.
• Chwazi Fèy travay nan tab dwat (oswa agoch) epi chwazi opsyon Chanje.
• Ajoute kòd 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

Sove liv travay la ak makro aktive (pa egzanp, kòm yon fichye .xlsm).

Koulye a, chak fwa nou mete ajou yon selil nan kolòn B (soti nan ranje 1 a ranje 10), selil la nan kolòn A pral otomatikman montre dat ak lè aktyèl la.

Ercole Palmeri