Makro Kod Listesi

Excel de kullanılan Makro Kodlarının Listesi

ID : 2011
ISLEM : sürücünün dosya formatını öğrenme
MAKRO KODU : Sub Give_Filesystem() Dim myFSO As Object, myDrv As Object, strFS As String Set myFSO = CreateObject("Scripting.FileSystemObject") Set myDrv = myFSO.GetDrive("c:") strFS = myDrv.FileSystem MsgBox strFS End Sub

ID : 2012
ISLEM : sürürcü5) sürücü tipi göster
MAKRO KODU : Sub Sürücü_Tipi_Göster() On Error GoTo hata: Dim ds, d, s, t Set ds = CreateObject("Scripting.FileSystemObject") Set d = ds.GetDrive("F:\") Select Case d.DriveType Case 0: t = "Bilinmiyor" Case 1: t = "Çıkarılabilir" Case 2: t = "HardDisk" Case 3: t = "Ağ" Case 4: t = "CD-ROM" Case 5: t = "RAM Disk" End Select s = "Sürücü " & d.DriveLetter & ": " & t MsgBox s End hata: MsgBox "Böyle Bir Sürücü Yok" End Sub

ID : 2013
ISLEM : sütun aktarma ayınısı gibi c,i
MAKRO KODU : Sub AKTAR1() Range("l1:l100").ClearContents For x = 1 To 100 If Cells(x, 3) <> "" Then Cells(x, 12) = Cells(x, 3) Next End Sub

ID : 2014
ISLEM : sütun aktarma sırasıyla, boşluk silerek c,i
MAKRO KODU : Sub AKTAR2() c = 0 Range("l1:l100").ClearContents For x = 1 To 100 If Cells(x, 3) <> "" Then c = c + 1 Cells(c, 12) = Cells(x, 3) End If Next End Sub

ID : 2015
ISLEM : sütun başlıkları rc stili ve normal stil
MAKRO KODU : Sub Spaltenziffern() With Application .ReferenceStyle = xlR1C1 End With End Sub Sub Spaltenbuchstaben() With Application .ReferenceStyle = xlA1 End With End Sub

ID : 2016
ISLEM : sütun genişliği 5 ayarla
MAKRO KODU : Sub LargeurColonne() For Each col In Selection.Columns If col.Column Mod 2 = 0 Then col.ColumnWidth = 5 End If Next col End Sub

ID : 2017
ISLEM : sütun genişliği ayarlama penceresi
MAKRO KODU : Sub Dialog_13() Application.Dialogs(xlDialogColumnWidth).Show End Sub

ID : 2018
ISLEM : sütun gizleme şartlı
MAKRO KODU : A1:AL1 hücreleri arasında "Mahmut" yazan sütunları gizleme For Each ALAN In Range("A1:AL1") If ALAN.Value <> "Mahmut" Then ALAN.EntireColumn.Hidden = True End If Next End Sub

ID : 2019
ISLEM : sütunda arama
MAKRO KODU : Seç hücre=columns(“D”).Find (what:=”ist.”) - --> D sütununda “ist.” Sözcüğü aranıyor.Bulunan ilk hücrenin adresi hücre değişkenine atanıyor.What , find metodun bir argümanıdır.

ID : 2020
ISLEM : sütunda boş olan satırları hepsini sil
MAKRO KODU : Sub sil() Range("c1").Select Application.ScreenUpdating = False Dim hucre As Range For Each hucre In Range("c1:c" & WorksheetFunction.CountA(Range("c1:c5000"))) Do While Not IsEmpty(ActiveCell) ActiveCell.Offset(1, 0).Select Loop ActiveCell.EntireRow.Select Selection.Delete Shift:=xlUp Next Application.ScreenUpdating = True End Sub

ID : 2021
ISLEM : sütunda boş olan satırları teker teker sil
MAKRO KODU : Sub sil() Range("c1").Select Application.ScreenUpdating = False Dim hucre As Range For Each hucre In Range("c1:c" & WorksheetFunction.CountA(Range("c1:c5000"))) Do While Not IsEmpty(ActiveCell) ActiveCell.Offset(1, 0).Select Loop ActiveCell.EntireRow.Select Selection.Delete Shift:=xlUp Next Application.ScreenUpdating = True End Sub

ID : 2022
ISLEM : sütunda dolu olanları seçer c
MAKRO KODU : Sub Düğme1_Tıklat() ActiveSheet.UsedRange.Select Range("c1:c" & Cells(65536, 3).End(xlUp).Row).Select End Sub

ID : 2023
ISLEM : sütunda satırları seç boş olanları silsin
MAKRO KODU : Sub DeleteRow() Application.ScreenUpdating = False Dim N As Long For N = Selection(1, 1).Row + Selection.Rows.Count - 1 _ To Selection(1, 1).Row Step -1 With Cells(N, 1) If .Value = 0 And Not .HasFormula Then .EntireRow.Delete End If End With Next N End sub

ID : 2024
ISLEM : sütundaki (a:a) dolu satırların altına boş satır ekler
MAKRO KODU : Sub ZeileEinfuegen() Dim Zeile As Integer Zeile = 2 Application.ScreenUpdating = False Do Until Range("a" & Zeile).Value = "" Rows(Zeile & ":" & Zeile).Select Selection.Insert Shift:=xlDown Zeile = Zeile + 2 Loop Range("A1").Select Application.ScreenUpdating = True End Sub

ID : 2025
ISLEM : sütundaki dolu olanları 65536 dan çıkarır
MAKRO KODU : Sub CountCellvide() numBlanks = 0 For Each c In Selection If c.Value = "" Then numBlanks = numBlanks + 1 End If Next c MsgBox "Il y a " & numBlanks & " cellules vides dans cette plage." End Sub

ID : 2026
ISLEM : sütundaki en son dolu satırın bir altındaki boş satıra gider
MAKRO KODU : Sub leere_zelle() [A1].Select ActiveCell.End(xlDown).Select ActiveCell.Offset(1, 0).Range("A1").Select End Sub Sub zahl_suchen() leere_Zeile = Range("A" & Rows.Count).End(xlUp).Row + 1 For i = 1 To leere_Zeile Range("A" & i).Select If ActiveCell = 5 Then Exit Sub Next i End Sub

ID : 2027
ISLEM : sütundaki harfler ve rakamlardan rakamları ayırır
MAKRO KODU : Private Sub metinayikla() Dim nums As String For i = 1 To Cells(65536, 1).End(xlUp).Row For b = 1 To Len(Cells(i, 1)) If IsNumeric(Mid(Cells(i, 1), b, 1)) = True Then nums = nums & Mid(Cells(i, 1), b, 1) End If Next b Cells(i, 1) = nums nums = "" Next i End Sub

ID : 2028
ISLEM : sütundaki ilk boş hücreye gider
MAKRO KODU : Sub BosHucreyeGit() ActiveCell.End(xlDown).Offset(1, 0).Select ' sütundaki ilk boş hücreye gider End Sub

ID : 2029
ISLEM : sütundaki satır sayısını öğrenme
MAKRO KODU : Sub NombreDeLigne() With Selection MsgBox Selection.Rows.Count End With End Sub

ID : 2030
ISLEM : sütunlarin gizlenmesi
MAKRO KODU : Aşağıdaki kodu uygulayınız. (Sayfa yazdırma ayarlarınızı yaptığınızı varsaydım.) Kod: Sub GİZLE_YAZDIR() Range("C:C,F:F,H:H").Select 'Buradaki sütunları artırabilirsiniz. Selection.EntireColumn.Hidden = True Range("A1").Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End Sub Gizlenen sütunlarıda tekrar görünür hale getirmek için aşağıdaki kodu uygulayın. Kod: Sub SÜTUNLARI_GÖSTER() Range("C:C,F:F,H:H").Select Selection.EntireColumn.Hidden = False Range("A1").Select End Sub

ID : 2031
ISLEM : sütunu hücredeki veriye göre daraltma
MAKRO KODU : Sub ajuste_colonne() Selection.Columns.AutoFit End Sub

ID : 2032
ISLEM : sütunu seç dolu olan veri sayısı söylesin
MAKRO KODU : Sub CompteLesNonVides() NonVide = 0 For Each Cellule In Selection.Cells If Not IsEmpty(Cellule) Then NonVide = NonVide + 1 Next MsgBox "Il y a " & NonVide & " cellules non vides dans la sélection" End Sub

ID : 2033
ISLEM : sütunu seç kırmızı renkli rakamları a1 e toplasın
MAKRO KODU : Sub Somme_Rouge() Dim Cel As Range Dim SomRoug As Integer For Each Cel In Selection If Cel.Font.ColorIndex = 3 Then SomRoug = SomRoug + Cel End If Next Range("A1") = SomRoug End Sub

ID : 2034
ISLEM : sütunu seç verili hücreden itibaren seçsin
MAKRO KODU : Sub Select_from_ActiveCell_to_Last_Cell_in_Column() Dim topCel As Range Dim bottomCel As Range On Error GoTo errorHandler Set topCel = ActiveCell Set bottomCel = Cells((65536), topCel.Column).End(xlUp) If bottomCel.Row >= topCel.Row Then Range(topCel, bottomCel).Select End If Exit Sub errorHandler: MsgBox "Error no. " & Err & " - " & Error End Sub

ID : 2035
ISLEM : sütunun sonuna kadar yandaki iki sütunun farkini al
MAKRO KODU : Sub Auto_Open() [M1] = WorksheetFunction.Sum(Range("L1:L65536")) - WorksheetFunction.Sum(Range("J1:J65536")) End Sub

ID : 2036
ISLEM : sütunundaki dolu hücreleri bulur ve yazdırma alanı içine alır
MAKRO KODU : Sub setPrintArea() Dim rng As Range Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) stcell = "A1": lcell = rng.Address ActiveSheet.PageSetup.PrintArea = stcell & ":" & lcell End Sub

ID : 2037
ISLEM : süzlü aktarma
MAKRO KODU : 1. Veri adında bir sayfayı index'i 1 olacak şekilde ayarlayın. Yani en sol başa yerleştirin. 2. Veri sayfasına A1'den başlayarak isimleri sırasıyla yazınız. 3. Veri sayfasını takip eden ilk Sayfa'da bahsettiğiniz değerler olsun. Yani bu sayfanında index'i 2 olmalı. Soldan ikinci sayfa yani. 4. Yeteri kadar sayfa açın. Yani isimleriniz kadar sayfa ekleyin. Bunu otomatik de yapabilirdik ama bu satırları yazarken aklıma geldi. Aşağıdaki kodu ekleyin. Sub Aktarma_Yap() Dim i As Integer Set veri = Worksheets("Veri") For i = 1 To 2 Range("A1").AutoFilter Range("A1").AutoFilter Field:=1, Criteria1:=veri.Cells(i, 1) Range("A1").CurrentRegion.Copy Sheets(i + 2).Range("A1") Next i End Sub Değerlerinizin olduğu sayfadan bu kodu çalıştırın

ID : 2038
ISLEM : süzme sütunda kırmızıları (butonla)
MAKRO KODU : Private Sub CommandButton1_Click() k = 1 For i = 1 To Range("B65536").End(xlUp).Row If Range("A" & i).Font.Color = vbRed Then Cells(k, 3) = Cells(i, 2) k = k + 1 End If Next i End Sub

ID : 2039
ISLEM : süzülenlerin comboboxta sıralanması
MAKRO KODU : Selection.AutoFilter Field:=5, Criteria1:=ComboBox1.Value

ID : 2040
ISLEM : şarta bağli makro
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) If [B18].Value = 20 Then Call Makro1 End If End Sub