Faydalı Excel Makro Kod Örnekleri

Faydalı Excel Makro kod örnekleri isimli bu yazımızda, işinize yarayacak bir çok Excel makrosunu tek bir içerikte bulabilirsiniz.

Faydalı Excel VBA Kodları

Aşağıya ekleyeceğimiz kod örneklerini kullanarak daha önce hiç VBA kodlarını kullanmamış olsanız dahi, kolayca ne işe yaradığını anlayacaksınız. Tüm örnek kodlara, içeriği anlaşılacak şekilde başlık verilmiştir.
Tabi makrolara ilk adımı atıyorsanız, öncesinde kodlarımızı yapıştıracağımız VB penceresinin nasıl açılacağını bilmek gerekir.
VB penceresine, Şerit Menü -> Geliştirici sekmesinden ulaşabilirsiniz ya da kısayol olarak Alt ve F11 tuşlarını kullanabilirsiniz.
Eğer menüde Geliştirici sekmesi yoksa, paniklemeyin ve buraya tıklayın.

Artık VB penceresinin nasıl açılacağını öğrendiğinize göre, boş bir Excel sayfası açıkken VB penceresine geçiş yapın ve Menü'den Insert -> Module diyerek boş bir kod alanı açarak aşağıdaki kodlarımızı denemeye başlayın.

TEMEL KODLAR

Otomatik sıra numarası ekleme


Aşağıdaki örnek kod, aktif hücrenin bulunduğu yerden itibaren aşağı doğru yazacağınız kadar sayıyı 1'den başlayarak sıralama işlevi görmektedir.
Sub YazdığınızSayıKadarOtomatikEkleme()
Dim i As Integer
On Error GoTo Son

 i = InputBox("Sayı yazın", "Bir sayı yazın")
 For i = 1 To i
 ActiveCell.Value = i
 ActiveCell.Offset(1, 0).Activate
 Next i

Son: Exit Sub
End Sub


Sub BirdenFazlaSütunEkle()
Dim i As Integer
Dim j As Integer

ActiveCell.EntireColumn.Select

On Error GoTo Son
i = InputBox("Eklenecek sütun sayısını girin", "Sütun Ekle")
For j = 1 To i
 Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromRightorAbove
Next j

Son: Exit Sub
End Sub


Sub BirdenFazlaSatırEkle()
Dim i As Integer
Dim j As Integer

ActiveCell.EntireRow.Select

On Error GoTo Son
i = InputBox("Eklenecek satır sayısını girin", "Satır Ekle")
For j = 1 To i
 Selection.Insert Shift:=xlToDown, CopyOrigin:=xlFormatFromRightorAbove
Next j

Son: Exit Sub
End Sub


Sub OtomatikSütunGenişliği()
Cells.Select
Cells.EntireColumn.AutoFit
End Sub


Sub OtomatikSatırGenişliği()
Cells.Select
Cells.EntireRow.AutoFit
End Sub


Sub MetniKaydırİptal()
Cells.Select
Selection.WrapText = False
Cells.EntireRow.AutoFit
Cells.EntireColumn.AutoFit
End Sub


Sub BirleştirilmişHücreleriİptalEt()
Selection.UnMerge
End Sub


Sub HesapMakinesiniAç()
Application.ActivateMicrosoftApp Index:=0
End Sub


Sub AltÜstBilgiyeTarihEkleme()
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&D"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&D"
.RightFooter = ""
End With
ActiveWindow.View = xlNormalView
End Sub


Sub ÖzelAltÜstBilgi()
Dim myText As Stringmy
Text = InputBox("Metninizi buraya girin", "Metin Girişi")
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = myText
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With
End Sub


Sub TekrarlayanVerileriVurgulama()
Dim Alan As Range
Dim Hucre As Range
Set Alan = Selection

For Each Hucre In Alan
 If WorksheetFunction.CountIf(Alan, Hucre.Value) > 1 Then
 Hucre.Interior.ColorIndex = 36
 End If
Next Hucre
End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Alan As String

Alan = Target.Cells.Address & "," & Target.Cells.EntireColumn.Address & "," & Target.Cells.EntireRow.Address
Range(Alan).Select
End Sub


Sub Top10()
Selection.FormatConditions.AddTop10
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.TopBottom = xlTop10Top
.Rank = 10
.Percent = False
End With
With Selection.FormatConditions(1).Font
.Color = -16752384
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13561798
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub


Sub AdTanımlamaYapılmışAlanlarıVurgulama()
Dim Alan As Name
Dim VurgulananAlan As Range

On Error Resume Next
For Each Alan In ActiveWorkbook.Names
 Set VurgulananAlan = Alan.RefersToRange
 VurgulananAlan.Interior.ColorIndex = 36
Next Alan
End Sub


Sub XDeğerdenBüyükOlanlarıVurgulama()
Dim i As Integer
i = InputBox("Bir değer yazın", "Veri Girişi")
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:=i
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.Font.Color = RGB(0, 0, 0)
.Interior.Color = RGB(31, 218, 154)
End With
End Sub


Sub XDeğerdenKüçükOlanlarıVurgulama()
Dim i As Integer
i = InputBox("Bir değer yazın", "Veri Girişi")
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLower, Formula1:=i
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.Font.Color = RGB(0, 0, 0)
.Interior.Color = RGB(217, 83, 79)
End With
End Sub


Sub NegatifSayılarıVurgulama()
Dim Alan As Range

For Each Alan In Selection
 If WorksheetFunction.IsNumber(Alan) Then
 If Alan.Value < 0 Then
 Alan.Font.Color = -16776961
 End If
 End If
Next
End Sub


Sub YorumlarıİçerenHücreleriVurgula()
Selection.SpecialCells(xlCellTypeComments).Select
Selection.Style = "Not" 'ingilizce versiyonlar "Note" yazılır
End Sub


Sub HatalıHücreleriVurgulama()
Dim Alan As Range
Dim i As Integer
For Each Alan In ActiveSheet.UsedRange
 If WorksheetFunction.IsError(Alan) Then
 i = i + 1
 Alan.Style = "Kötü" 'ingilizce versiyonlar "Bad" yazılır
 End If
Next Alan
MsgBox "Toplam " & i & " hatalı hücre var."
End Sub


Sub YanlışYazılmışKelimeleriVurgula()
Dim Alan As Range
For Each Alan In ActiveSheet.UsedRange
If Not Application.CheckSpelling(word:=Alan.Text) Then
 Alan.Style = "Kötü"
End If
Next Alan
End Sub


Sub BirDeğeriVurgulama()
Dim Alan As Range
Dim i As Integer
Dim c As Variant
c = InputBox("Vurgulanacak değeri girin")
For Each Alan In ActiveSheet.UsedRange
If Alan = c Then
Alan.Style = "Not"
i = i + 1
End If
Next Alan
End Sub


Sub BoşlukOlanHücreleriVurgulama()
Dim Alan As Range
For Each Alan In ActiveSheet.UsedRange
If Alan.Value = " " Then
 Alan.Style = "Not"
End If
Next Alan
End Sub


Sub AralıktakiMaxDeğeriVurgulama()
Dim Alan As Range
For Each Alan In Selection
If Alan = WorksheetFunction.Max(Selection) Then
 Alan.Style = "İyi"
End If
Next Alan
End Sub


Sub AralıktakiMinDeğeriVurgulama()
Dim Alan As Range
For Each Alan In Selection
If Alan = WorksheetFunction.Min(Selection) Then
 Alan.Style = "İyi"
End If
Next Alan
End Sub


Sub BenzersizDeğerleriVurgulama()
Dim Alan As Range
Set Alan = Selection
Alan.FormatConditions.Delete
Dim uv As UniqueValues
Set uv = Alan.FormatConditions.AddUniqueValues
uv.DupeUnique = xlUnique
uv.Interior.Color = vbGreen
End Sub


Sub SütunlardakiFarkıVurgulama()
Range("H7:H8,I7:I8").Select
Selection.ColumnDifferences(ActiveCell).Select
Selection.Style = "Kötü"
End Sub


Sub SütunlardakiFarkıVurgulama()
Range("H7:H8,I7:I8").Select
Selection.RowDifferences(ActiveCell).Select
Selection.Style = "Kötü"
End Sub


Sub YorumlarıYazdır()
With ActiveSheet.PageSetup
 .printComments = xlPrintSheetEnd
End With
End Sub


Sub SeçimiYazdır()
ActiveSheet.Range("A1:A5").Select
Selection.PrintOut Copies:=1, Collate:=True
End Sub


Sub ÖzelSayfalarıYazdır()
Dim startpage As Integer
Dim endpage As Integer
startpage = InputBox("Yazdırmak istediğiniz ilk sayfanın numarasını yazınız.", "Değer girin")
If Not WorksheetFunction.IsNumber(startpage) Then
 MsgBox "Geçersiz ilk sayfa numarası. Lütfen tekrar deneyin.", "Hata"
 Exit Sub
End If
endpage = InputBox("Yazdırmak istediğiniz son sayfanın numarasını yazınız.", "Değer girin")
If Not WorksheetFunction.IsNumber(endpage) Then
 MsgBox "Geçersiz son sayfa numarası. Lütfen tekrar deneyin.", "Hata"
 Exit Sub
End If
Selection.PrintOut From:=startpage, To:=endpage, Copies:=1, Collate:=True
End Sub


Sub SayfalariGizleme()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
 If ws.Name <> ThisWorkbook.ActiveSheet.Name Then
 ws.Visible = xlSheetHidden
 End If
Next ws
End Sub


Sub SayfalarıGöster()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
 ws.Visible = xlSheetVisible
Next ws
End Sub


Sub SayfalarıSil()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
 If ws.Name <> ThisWorkbook.ActiveSheet.Name Then
 Application.DisplayAlerts = False
 ws.Delete
 Application.DisplayAlerts = True
 End If
Next ws
End Sub


Sub TümSayfalarıKoru()
Dim ws As Worksheet
Dim ps As String
ps = InputBox("Enter a Password.", vbOKCancel)
For Each ws In ActiveWorkbook.Worksheets
 ws.Protect Password:=ps
Next ws
End Sub


Sub GrafikleriBoyutlandır()
Dim i As Integer
For i = 1 To ActiveSheet.ChartObjects.Count
With ActiveSheet.ChartObjects(i)
 .Width = 300
 .Height = 200
End With
Next i
End Sub


Sub ÇokluSayfaEkleme()
Dim i As Integer
i = InputBox("Eklenecek sayfa sayısını girin.", "Sayfa adeti")
Sheets.Add After:=ActiveSheet, Count:=i
End Sub


Sub SayfaKoruma()
ActiveSheet.Protect "Parolanız", True, True
End Sub


Sub ProtectWS()
ActiveSheet.Protect "Parolanız", True, True
End Sub


Sub SayfaSıralama()
Dim i As Integer
Dim j As Integer
Dim iAnswer As VbMsgBoxResult
iAnswer = MsgBox("Sayfaları Artan Düzende Sıralamak İster misiniz?" & Chr(10) & "Hayır derseniz Azalan Sıralamada sıralanır", vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sayfa sıralama")
For i = 1 To Sheets.Count
 For j = 1 To Sheets.Count - 1
 If iAnswer = vbYes Then
 If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
 Sheets(j).Move After:=Sheets(j + 1)
 End If
 ElseIf iAnswer = vbNo Then
 If UCase$(Sheets(j).Name) < UCase$(Sheets(j + 1).Name) Then
 Sheets(j).Move After:=Sheets(j + 1)
 End If
 End If
 Next j
Next i
End Sub


Sub FormüllüHücreleriKoruma()
With ActiveSheet
 .Unprotect
 .Cells.Locked = False
 .Cells.SpecialCells(xlCellTypeFormulas).Locked = True
 .Protect AllowDeletingRows:=True
End With
End Sub


Sub BoşÇalışmaSayfalarınıSil()
Dim Ws As Worksheet
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each Ws In Application.Worksheets
 If Application.WorksheetFunction.CountA(Ws.UsedRange) = 0 Then
 Ws.Delete
 End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Sub SatırSütunlarıGöster()
Columns.EntireColumn.Hidden = False
Rows.EntireRow.Hidden = False
End Sub


Sub SayfayıPDFYapma()
Dimws As Worksheet
For Each Ws In Worksheets
 Ws.ExportAsFixedFormat xlTypePDF, "Klasör Adını Yazın" & Ws.Name & ".pdf"
Next Ws
End Sub


Sub SayfaSonlarınıDevreDışıBırakma()
Dim wb As Workbook
Dim wks As Worksheet
Application.ScreenUpdating = False
For Each wb In Application.Workbooks
 For Each Sht In wb.Worksheets
 Sht.DisplayPageBreaks = False
 Next Sht
Next wb
Application.ScreenUpdating = True
End Sub


Sub DosyayıYedekle()
ThisWorkbook.SaveCopyAs Filename:=ThisWorkbook.Path & "" & Format(Date, "dd.mm.yyyy") & " " & ThisWorkbook.Name
End Sub


Sub TümÇalışmaKitaplarınıKapatma()
Dim wbs As Workbook
For Each wbs In Workbooks
 wbs.Close SaveChanges:=True
Next wb
End Sub


Sub AktifÇalışmaSayfasınıYeniÇalışmaKitabınaKopyalama()
ThisWorkbook.ActiveSheet.Copy Before:=Workbooks.Add.Worksheets(1)
End Sub


Sub MailYolla()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
 .to = "admin@exceldepo.com"
 .Subject = "Aktif çalışma kitabının mail olarak gönderilmesi"
 .Body = "Başarılı bir şekilde test edilmiştir."
 .Attachments.Add ActiveWorkbook.FullName
 .display
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Sub EPostaEkineÇalışmaKitabEkleme()
Application.Dialogs(xlDialogSendMail).Show
End Sub


Sub auto_open()
MsgBox "ExcelDepo.Com'a hoşgeldiniz & ziyaretiniz için teşekkürler."
End Sub


Sub auto_close()
MsgBox "Hoşçakalın! ExcelDepo.Com'u tekrar ziyaret etmeyi unutmayın."
End Sub


Sub AçıkOlupKaydedilmemişÇalışmaKitaplarınıSayma()
Dim book As Workbook
Dim i As Integer
For Each book In Workbooks
 If book.Saved = False Then
 i = i + 1
 End If
Next book
MsgBox i
End Sub


Sub AltToplamlarıGizleme()
Dim pt As PivotTable
Dim pf As PivotField
On Error Resume Next
Set pt = ActiveSheet.PivotTables(ActiveCell.PivotTable.Name)
If pt Is Nothing Then
 MsgBox "Cursor'u bir özet tablo içine yerleştirmeniz gerekir."
 Exit Sub
End If
For Each pf In pt.PivotFields
 pf.Subtotals(1) = True
 pf.Subtotals(1) = False
Next pf
End Sub


Sub UpdatePivotTableRange()
Dim Data_Sheet As Worksheet
Dim Pivot_Sheet As Worksheet
Dim StartPoint As Range
Dim DataRange As Range
Dim PivotName As String
Dim NewRange As String
Dim LastCol As Long
Dim lastRow As Long

Set Data_Sheet = ThisWorkbook.Worksheets("PivotTableData3")
Set Pivot_Sheet = ThisWorkbook.Worksheets("Pivot3")

PivotName = "PivotTable2"

Data_Sheet.Activate
Set StartPoint = Data_Sheet.Range("A1")
LastCol = StartPoint.End(xlToRight).Column
DownCell = StartPoint.End(xlDown).Row
Set DataRange = Data_Sheet.Range(StartPoint, Cells(DownCell, LastCol))
NewRange = Data_Sheet.Name & "!" & DataRange.Address(ReferenceStyle:=xlR1C1)

Pivot_Sheet.PivotTables(PivotName). _
ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)

Pivot_Sheet.PivotTables(PivotName).RefreshTable

Pivot_Sheet.Activate
MsgBox "Özet tablo güncellendi."
End Sub


Sub activateGetPivotData()
Application.GenerateGetPivotData = True
End Sub
Sub deactivateGetPivotData()
Application.GenerateGetPivotData = False
End Sub


Sub GrafikTürünüDeğiştirme()
ActiveChart.ChartType = xlColumnClustered
End Sub


Sub GrafiğiResimOlarakYapıştırma()
ActiveChart.ChartArea.Copy
ActiveSheet.Range("A1").Select
ActiveSheet.Pictures.Paste.Select
End Sub


Sub GrafikBaşlığıEkleme()
Dim i As Variant
i = InputBox("Başlık girin", "Grafik başlığı")
On Error GoTo Son
ActiveChart.SetElement (msoElementChartTitleAboveChart)
ActiveChart.ChartTitle.Text = i
Son:
Exit Sub
End Sub


Sub DeğereDönüştürme()
Dim Alan As Range
Dim Hucre As Range
Select Case MsgBox("Formülleri değere dönüştürmek istediğinize emin misiniz?" & "Önce dosyanızı kaydetmek ister misiniz??", vbYesNoCancel, "Uyarı")
Case Is = vbYes
ThisWorkbook.Save
Case Is = vbCancel
Exit Sub
End Select
Set Alan = Selection
For Each Hucre In Alan
If Hucre.HasFormula Then
Hucre.Formula = Hucre.Value
End If
Next Hucre
End Sub


Sub BoşluklarıKaldırma()
Dim Alan As Range
Dim Hucre As Range
Select Case MsgBox("Formülleri değere dönüştürmek istediğinize emin misiniz?" & "Önce dosyanızı kaydetmek ister misiniz??", vbYesNoCancel, "Uyarı")
Case Is = vbYesThisWorkbook.Save
Case Is = vbCancel
Exit Sub
End Select
Set Alan = Selection
For Each Hucre In Alan
If Not IsEmpty(Hucre) Then
Hucre = Trim(Hucre)
End If
Next Hucre
End Sub


Public Function KarakterKaldırma(rng As String, cnt As Long)
KarakterKaldırma = Right(rng, Len(rng) - cnt)
End Function


Sub DereceSimgesiEkleme()
Dim rng As Range
For Each rng In Selection
 rng.Select
 If ActiveCell <> "" Then
 If IsNumeric(ActiveCell.Value) Then
 ActiveCell.Value = ActiveCell.Value & "°"
 End If
 End If
Next
End Sub


Public Function TersÇevirme(ByVal cell As Range) As String
TersÇevirme = VBA.StrReverse(cell.Value)
End Function


Sub ActivateA1()
If Application.ReferenceStyle = xlR1C1 Then
 Application.ReferenceStyle = xlA1
Else
 Application.ReferenceStyle = xlA1
End If
End Sub


Sub SaatEkle()
Dim i As Integer
For i = 1 To 24
 ActiveCell.FormulaR1C1 = i & ":00"
 ActiveCell.NumberFormat = "[$-409]hh:mm;@"
 ActiveCell.Offset(RowOffset:=1, ColumnOffset:=0).Select
Next i
End Sub


Sub TarihiGüneDönüştür()
Dim tempCell As Range
Selection.Value = Selection.Value
For Each tempCell In Selection
 If IsDate(tempCell) = True Then
 With tempCell
 .Value = Day(tempCell)
 .NumberFormat = "0"
 End With
 End If
Next tempCell
End Sub


Sub TarihiYılaDönüştür()
Dim tempCell As Range
Selection.Value = Selection.Value
For Each tempCell In Selection
 If IsDate(tempCell) = True Then
 With tempCell
 .Value = Year(tempCell)
 .NumberFormat = "0"
 End With
 End If
Next tempCell
End Sub


Sub TarihtenSaatiKaldırma()
Dim Rng As Range
For Each Rng In Selection
 If IsDate(Rng) = True Then
 Rng.Value = VBA.Int(Rng.Value)
 End If
Next
Selection.NumberFormat = "dd.mm.yyyy"
End Sub


Sub TarihSaattenTarihiKaldırma()
Dim Rng As Range
For Each Rng In Selection
 If IsDate(Rng) = True Then
 Rng.Value = Rng.Value - VBA.Fix(Rng.Value)
 End If
Next
Selection.NumberFormat = "hh:mm:ss"
End Sub


Sub BüyükHarfeDönüştürme()
Dim Rng As Range
For Each Rng In Selection
 If Application.WorksheetFunction.IsText(Rng) Then
 Rng.Value = UCase(Rng)
 End If
Next
End Sub


Sub KüçükHarfeDönüştürme()
Dim Rng As Range
For Each Rng In Selection
 If Application.WorksheetFunction.IsText(Rng) Then
 Rng.Value = LCase(Rng)
 End If
Next
End Sub


Sub BaşHarfleriBüyükYapma()
Dim Rng As Range
For Each Rng In Selection
 If WorksheetFunction.IsText(Rng) Then
 Rng.Value = WorksheetFunction.Proper(Rng.Value)
 End If
Next
End Sub


Sub CümleyeDönüştürme()
Dim Rng As Range
For Each Rng In Selection
 If WorksheetFunction.IsText(Rng) Then
 Rng.Value = UCase(Left(Rng, 1)) & LCase(Right(Rng, Len(Rng) - 1))
 End If
Next Rng
End Sub


Sub KarakterKaldırma()
Dim Rng As Range
Dim rc As String
rc = InputBox("Kaldırılacak karakteri yazın", "Birşeyler yaz")
For Each Rng In Selection
 Selection.Replace What:=rc, Replacement:=""
Next
End Sub


Sub KelimeSayma()
Dim WordCnt As Long
Dim rng As Range
Dim S As String
Dim N As Long
For Each rng In ActiveSheet.UsedRange.Cells
 S = Application.WorksheetFunction.Trim(rng.Text)
 N = 0
 If S <> vbNullString Then
 N = Len(S) - Len(Replace(S, " ", "")) + 1
 End If
 WordCnt = WordCnt + N
Next rng
MsgBox "Sayfada toplam " & Format(WordCnt, "#,##0") & " kelime var"
End Sub


Sub OndalıkSayıyıKaldırma()
Dim lnumber As Double
Dim lResult As Long
Dim rng As Range
For Each rng In Selection
 rng.Value = Int(rng)
 rng.NumberFormat = "0"
Next rng
End Sub


Sub multiplyWithNumber()
Dim rng As Range
Dim c As Integer
c = InputBox("Çarpılacak bir sayı girin", "Gerekli alan")
For Each rng In Selection
 If WorksheetFunction.IsNumber(rng) Then
 rng.Value = rng * c
 Else
 End If
Next rng
End Sub


Sub SayıEkleme()
Dim rng As Range
Dim i As Integer
i = InputBox("Eklenecek bir sayı girin", "Gerekli alan")
For Each rng In Selection
 If WorksheetFunction.IsNumber(rng) Then
 rng.Value = rng + i
 Else
 End If
Next rng
End Sub


Sub KarakökHesapla()
Dim rng As Range
Dim i As Integer
For Each rng In Selection
 If WorksheetFunction.IsNumber(rng) Then
 rng.Value = Sqr(rng)
 Else
 End If
Next rng
End Sub


Sub KüpKökHesaplama()
Dim rng As Range
Dim i As Integer
For Each rng In Selection
 If WorksheetFunction.IsNumber(rng) Then
 rng.Value = rng ^ (1 / 3)
 Else
 End If
Next rng
End Sub


Sub Negatif İşaretleri Kaldırma()
Dim rng As Range
Selection.Value = Selection.Value
For Each rng In Selection
 If WorksheetFunction.IsNumber(rng) Then
 rng.Value = Abs(rng)
 End If
Next rng
End Sub


Sub BoşHücreleriSıfırlarlaDeğiştirme()
Dim rng As Range
Selection.Value = Selection.Value
For Each rng In Selection
 If rng = "" Or rng = " " Then
 rng.Value = "0"
 Else
 End If
Next rng
End Sub


Etiketler

Excel Eğitimleri
Üstteki alanda, Google Reklamları yerine sizin reklamınızın yayınlanmasını ister misiniz?
Reklam vermek istiyorum

Daha önce yorum yapılmamış!

Makale Arşivi
Klavyenizdeki F2 tuşuna basarsanız, hücrenin ya da formül çubuğunun için giriş yaparsınız.
Shift + F2 tuşlarına basarsanız, aktif hücreye açıklama eklersiniz.
Ctrl + F2 tuşlarına basarsanız, Yazdırma ekranını açarsınız.
Yükleniyor...