Excelde Basit Makro Uygulamaları

Makroyu uygulamak için alttaki adımları takip edin.

1. Excel uygulamasını başlatın.
2. Araçlar > Makro menüsünden Makrolar alt başlığına tıklayın.
3. Açılan pencerede Makro adına herhangi bir şey yazıp Oluştur butonuna tıklayın.
4. Bu durumda Visual Basic sayfası açılacaktır. Bu sayfada gördüğünüz her şeyi silip yukarıdaki makro kodunu olduğu gibi bu sayfaya yapıştırın.
5. Bu işlemden sonra Visual Basic sayfasının üst kısmındaki butonlardan Excel simgesi olana tıklayıp Excel çalışma sayfasına dönün.

Çalışma sayfasını kaydedin. Makro, çalışma sayfası ile birlikte kaydedilir.

BASİT MAKRO ÇALIŞMALARI

Alttaki makro A1 ve A2 hücrelerine yazılan rakamları toplayıp 2’ye böler.

Sub topla_böl()
Range("C1") = (Range("A1") + Range("A2")) / 2
End Sub

Alttaki makro A1 ile A10 hücrelerine girilen rakamları B1 hücresine toplam olarak yazar.

Sub Topla()
[B1].Value = Application.Sum([A1:A10])
End Sub

Alttaki makro D1 hücresime A1 ve B1 hücrelerindeki sayıların çarpımını yazar.

Sub Carp()
Range("D1") = Range("A1") * Range("B1")
Range("D1").Formula = "=(A1 * A1)"
End Sub

Alttaki makro ilk sayfayı aktif eder, A3 hücresine 5 yazıp, A4 hücresine formül oluşturur.

Sub degerformul()
Worksheets(1).Activate
ActiveSheet.Range("A3").Value = 5
ActiveSheet.Range("A4").Formula = "=A5+B8"
End Sub

Alttaki makro ile aktif sayfadaki formülleri ve toplam formül sayısını mesaj kutusunda gösterebilirsiniz.

Sub formullerim()
Dim R As Integer
R = 0
Range(Cells(1, 1), Selection.SpecialCells(xlLastCell)).Select
For Each Cell In Selection
If Left(Cell.Formula, 1) = "=" Then
R = R + 1
End If
Next Cell
Selection.SpecialCells(xlFormulas, 23).Select
MsgBox "Toplam " & R & " Formül " & _
ActiveSheet.Name & " Adlı Sayfada Bulundu"
End Sub

Alttaki makro aktif sayfadaki formülleri bulup yeni sayfada listeler.

Sub formullistele()
Dim FormulaCells As Range, Cell As Range
Dim FormulaSheet As Worksheet
Dim Row As Integer
' Create a Range object for all formula cells
On Error Resume Next
Set FormulaCells = Range("A1").SpecialCells(xlFormulas, 23)
' Exit if no formulas are found
If FormulaCells Is Nothing Then
MsgBox "No Formulas."
Exit Sub
End If
' Add a new worksheet
Application.ScreenUpdating = False
Set FormulaSheet = ActiveWorkbook.Worksheets.Add
FormulaSheet.Name = "Formulas in " & FormulaCells.Parent.Name
' Set up the column headings
With FormulaSheet
Range("A1") = "Address"
Range("B1") = "Formula"
Range("C1") = "Value"
Range("A1:C1").Font.Bold = True
End With
' Process each formula
Row = 2
For Each Cell In FormulaCells
Application.StatusBar = Format((Row - 1) / FormulaCells.Count, "0%")
With FormulaSheet
Cells(Row, 1) = Cell.Address _
(RowAbsolute:=False, ColumnAbsolute:=False)
Cells(Row, 2) = " " & Cell.Formula
Cells(Row, 3) = Cell.Value
Row = Row + 1
End With
Next Cell
' Adjust column widths
FormulaSheet.Columns("A:C").AutoFit
Application.StatusBar = False
End Sub

Alttaki makro aktif hücredeki formülü mesaj kutusunda gösterir.

Sub AddressFormulasMsgBox() 'Displays the address and formula in message box
For Each Item In Selection
If Mid(Item.Formula, 1, 1) = "=" Then
MsgBox "The formula in " & Item.Address(rowAbsolute:=False, _
columnAbsolute:=False) & " is: " & Item.Formula, vbInformation
End If
Next
End Sub

Alttaki makro seçtiğiniz hücrelerdeki formülleri açıklama olarak yazdırır.

Sub formulacikla()
Dim cell As Range
Selection.ClearComments
For Each cell In Selection
If cell.HasFormula Then
cell.AddComment cell.Formula
cell.Comment.Visible = False
cell.Comment.Shape.TextFrame.AutoSize = True
End If
Next cell
End Sub

Alttaki makro hücrelere verilen isimleri siler.

Sub DeleteRangeNames()
Dim rName As Name
For Each rName In ActiveWorkbook.Names
rName.Delete
Next rName
End Sub

Alttaki makro B1:G13 hücreleri arasındaki verileri 0 (sıfır) yapar.

Sub ResetTest1()
For Each n In Range("B1:G13") ' Substitute your range here
If n.Value <> 0 Then
n.Value = 0
End If
Next n
End Sub

Alttaki makro aktif hücreye girilen rakamları statusbarda toplar.

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim myVar As Double
myVar = Application.Sum(Columns(Target.Column))
If myVar <> 0 Then
Application.StatusBar = Format(myVar, "###,###")
Else
Application.StatusBar = False
End If
End Sub

Alttaki makro Toplam formülünü her defasında bir alta toplar.

Sub Addieren()
Dim rng As Range
Set rng = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
rng.Formula = "=SUM(A1:A" & rng.Row - 1 & ")"
End Sub

VBA yazılan formüllere kesin başvuru işareti koymak için kullanılan kodlar ($A$4)

Sub VariableInFormel()
Dim iCol As Integer
iCol = Range("B1").Value
Range("B2").Formula = _
"=SUM(R1C" & iCol & ":R100C" & iCol & ")"
End Sub 

Makroları kendi ihtiyaçlarınız doğrultusunda değiştirebilir ve geliştirebilirsiniz.