Zimanî babet

Nimûneyên Excel Macros bi VBA ve hatî nivîsandin

Mînakên makro yên Excel ên jêrîn bi karanîna VBA-yê hatine nivîsandin 

Dema xwendinê ya texmînkirî: 3 minuti

Mînaka VBA bi karanîna Array

Pêvajoya Sub jêrîn nirxan ji hucreyên di stûna A ya pelgeya xebatê de dixwîne, heya ku ew bi şaneyek vala re rû bi rû bimîne. Nirx di nav rêzek de têne tomar kirin. Ev mînaka makro ya Excel-ê ya hêsan karanîna karanîna destnîşan dike:

  • Daxuyaniyên guherbar;
  • Rêzikên dînamîk;
  • A cycle Do Until;
  • Di pelgeya xebatê ya Excel ya heyî de li hucreyan binihêrin;
  • Fonksiyona VBA Ubound çêkirî (ku nîşaneya herî bilind a array vedigerîne).
' 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

Prosedûra nirxan di stûna A ya pelgeya xebatê ya çalak de di rêzek de hilîne, bala xwe bidin ku:

  • The cycle Do Until nirxên her hucreyê di stûna A ya kargeha çalak de derdixe, şaneyên vala paşguh dike
  • şert"If UBound(dCellValues) < iRow” kontrol dike ku rêzika dCellValues ​​têra xwe mezin e ku agahdarî bigire, heke na, ReDim bikar bînin da ku mezinahiya rêzê 10 zêde bike.
  • Di dawiyê de, perwerdehiyê​​dCellValues(iRow) = Cells(iRow, 1).Value” Hucreya heyî di rêza CellValues ​​de hilîne

Mînaka VBA bi operasyonên matematîkî

Pêvajoya Sub jêrîn nirxan ji stûna A ya pelgeya xebatê ya bi navê "Sheet2" dixwîne û li ser nirxan operasyonên arîtmetîk pêk tîne. Nirxên encam di stûna A ya pelgeya xebatê ya heyî de têne çap kirin.

Ev makro diyar dike:

nûçenameya Innovation
Nûçeyên herî girîng ên li ser nûjeniyê ji bîr nekin. Sign up ji bo wergirtina wan bi e-nameyê.
  • Daxuyaniyên guherbar;
  • Tiştên Excel (bi taybetî, karanîna keyword Set û meriv çawa xwe bigihîne tiştê "Stûn" ji objekta "Sheets");
  • A cycle Do Until;
  • Di pirtûka xebatê ya Excel-ê ya heyî de pelên xebatê û rêzikên hucreyê bigihîjin.
' 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

Mînaka VBA bi tomarkirina dîroka guherandinê

Ka em makroyek VBA-ya hêsan binivîsin ku dema ku şaneyek di navberek taybetî ya pelê me de nûve dibe, dişewite. Bifikirin ku hûn dixwazin guhertinên di stûna B de (B4 heta B11) bişopînin û di stûna A de tarîx û dema guhertinê tomar bikin.
Werin em wiha bidomînin:

  • Di tabloyê de Developer li ser vebijarkê bikirtînin "Visual Basic" da ku edîtorê VBA vekin.
  • Di edîtorê VBA de, edîtorê kodê yê ku bi Sheet2 ve girêdayî ye du-bikirtînin.
  • Ji tabloya rastê (an çepê) Worksheet hilbijêrin û vebijarka Guhertinê hilbijêrin.
  • Koda VBA zêde bikin:
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

Pirtûka xebatê bi makroyên çalakkirî hilîne (mînak, wekî pelek .xlsm).


Naha, her gava ku em şaneyek di stûna B de nûve dikin (ji rêza 1 heya rêza 10), şaneya di stûna A de dê bixweber tarîx û demjimêra heyî nîşan bide.

Ercole Palmeri

nûçenameya Innovation
Nûçeyên herî girîng ên li ser nûjeniyê ji bîr nekin. Sign up ji bo wergirtina wan bi e-nameyê.

Gotarên dawî

Veeam ji parastinê bigire heya bersiv û başbûnê ji bo ransomware piştgirîya herî berfireh vedihewîne

Coveware ji hêla Veeam ve dê berdewam bike ku karûbarên bersivdayina bûyera xerckirina sîber peyda bike. Coveware dê kapasîteyên dadwerî û sererastkirinê pêşkêşî bike…

23 Nîsana 2024

Şoreşa Kesk û Dîjîtal: Ma Maintenance Pêşbînîdar Pîşesaziya Neft û Gazê Veguherîne Çawa

Lênêrîna pêşbînîkirî di sektora neft û gazê de, bi nêzîkatiyek nûjen û çalak a rêveberiya nebatê şoreşek dike.…

22 Nîsana 2024

Rêkûpêk antîtrust a Keyaniya Yekbûyî alarma BigTech li ser GenAI radike

CMA ya Keyaniya Yekbûyî di derbarê reftarên Big Tech de di bazara îstîxbarata çêkirî de hişyariyek derxist. Va…

18 Nîsana 2024

Casa Green: şoreşa enerjiyê ji bo pêşerojek domdar li Italytalyayê

Biryarnameya "Xalên Kesk", ku ji hêla Yekîtiya Ewropî ve ji bo zêdekirina karbidestiya enerjiyê ya avahiyan hatî damezrandin, pêvajoya xwe ya qanûnî bi…

18 Nîsana 2024