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


bir sutundaki uyusan verileri diger sutuna kopyalama

ID : 451
ISLEM : bir sutundaki uyusan verileri diger sutuna kopyalama
MAKRO KODU : Sub kont() baksut = "AI" kontsut = "AL" son = Cells(65536, baksut).End(3).Row For x = 1 To son - 1 For y = x + 1 To son If Cells(x, baksut) = Cells(y, baksut) And Cells(y, kontsut) = "" Then Cells(y, kontsut) = Cells(x, kontsut) Next y Next x End Sub

bir sürü dialog penceresi

ID : 452
ISLEM : bir sürü dialog penceresi
MAKRO KODU : Sub Dialog_51() Application.Dialogs(xlDialogOptionsView).Show End Sub Sub Dialog_52() Application.Dialogs(xlDialogOutline).Show End Sub Sub Dialog_53() Application.Dialogs(xlDialogPageSetup).Show End Sub Sub Dialog_54() Application.Dialogs(xlDialogParse).Show End Sub Sub Dialog_55() Application.Dialogs(xlDialogPasteSpecial).Show End Sub Sub Dialog_56() Application.Dialogs(xlDialogPatterns).Show End Sub Sub Dialog_57() Application.Dialogs(xlDialogPrint).Show End Sub Sub Dialog_58() Application.Dialogs(xlDialogPrinterSetup).Show End Sub Sub Dialog_59() Application.Dialogs(xlDialogPrintPreview).Show End Sub Sub Dialog_60() Application.Dialogs(xlDialogProperties).Show End Sub Sub Dialog_61() Application.Dialogs(xlDialogProtectDocument).Show End Sub Sub Dialog_62() Application.Dialogs(xlDialogProtectSharing).Show End Sub Sub Dialog_63() Application.Dialogs(xlDialogPublishAsWebPage).Show End Sub Sub Dialog_64() Application.Dialogs(xlDialogReplaceFont).Show End Sub Sub Dialog_65() Application.Dialogs(xlDialogRowHeight).Show End Sub Sub Dialog_66() Application.Dialogs(xlDialogRun).Show End Sub Sub Dialog_67() Application.Dialogs(xlDialogSaveAs).Show End Sub Sub Dialog_68() Application.Dialogs(xlDialogSaveWorkbook).Show End Sub Sub Dialog_69() Application.Dialogs(xlDialogSaveWorkspace).Show End Sub Sub Dialog_70() Application.Dialogs(xlDialogScenarioAdd).Show End Sub Sub Dialog_71() Application.Dialogs(xlDialogScenarioCells).Show End Sub Sub Dialog_72() Application.Dialogs(xlDialogScenarioMerge).Show End Sub Sub Dialog_73() Application.Dialogs(xlDialogSelectSpecial).Show End Sub Sub Dialog_74() Application.Dialogs(xlDialogSetBackgroundPicture).Show End Sub Sub Dialog_75() Application.Dialogs(xlDialogSetPrintTitles).Show End Sub Sub Dialog_76() Application.Dialogs(xlDialogShowToolbar).Show End Sub Sub Dialog_77() Application.Dialogs(xlDialogSort).Show End Sub Sub Dialog_78() Application.Dialogs(xlDialogStandardFont).Show End Sub Sub Dialog_79() Application.Dialogs(xlDialogStandardWidth).Show End Sub Sub Dialog_80() Application.Dialogs(xlDialogStyle).Show End Sub Sub Dialog_81() Application.Dialogs(xlDialogSummaryInfo).Show End Sub Sub Dialog_82() Application.Dialogs(xlDialogTable).Show End Sub Sub Dialog_83() Application.Dialogs(xlDialogTextToColumns).Show End Sub Sub Dialog_84() Application.Dialogs(xlDialogUnhide).Show End Sub Sub Dialog_85() Application.Dialogs(xlDialogWebOptionsEncoding).Show End Sub Sub Dialog_86() Application.Dialogs(xlDialogWebOptionsFiles).Show End Sub Sub Dialog_87() Application.Dialogs(xlDialogWebOptionsFonts).Show End Sub Sub Dialog_88() Application.Dialogs(xlDialogWebOptionsGeneral).Show End Sub Sub Dialog_89() Application.Dialogs(xlDialogWebOptionsPictures).Show End Sub Sub Dialog_90() Application.Dialogs(xlDialogWorkbookAdd).Show End Sub Sub Dialog_91() Application.Dialogs(xlDialogWorkbookCopy).Show End Sub Sub Dialog_92() Application.Dialogs(xlDialogWorkbookInsert).Show End Sub Sub Dialog_93() Application.Dialogs(xlDialogWorkbookMove).Show End Sub Sub Dialog_94() Application.Dialogs(xlDialogWorkbookName).Show End Sub Sub Dialog_95() Application.Dialogs(xlDialogWorkbookNew).Show End Sub Sub Dialog_96() Application.Dialogs(xlDialogWorkbookOptions).Show End Sub Sub Dialog_97() Application.Dialogs(xlDialogWorkbookProtect).Show End Sub Sub Dialog_98() Application.Dialogs(xlDialogWorkbookUnhide).Show End Sub Sub Dialog_99() Application.Dialogs(xlDialogWorkgroup).Show End Sub Sub Dialog_100() Application.Dialogs(xlDialogWorkspace).Show End Sub Sub Dialog_101() Application.Dialogs(xlDialogZoom).Show End Sub

bir sütundaki değerleri sayma

ID : 453
ISLEM : bir sütundaki değerleri sayma
MAKRO KODU : For i = 1 To Cells(65536, 1).End(xlUp).Row Cells(i, 2) = UBound(Split(Cells(i, 1), ",")) + 1 Next i

birden çok hücrede yuvarlama

ID : 454
ISLEM : birden çok hücrede yuvarlama
MAKRO KODU : A1hucresine =YUVARLA(A1;-5) 'B2hucresine =YUVARLA(B2;-5) 'C3hücresine =YUVARLA(C3;-5) Sub yuvarla() [A1] = Round((Range("A1").Value) / 50000) * 50000 [B2] = Round((Range("B2").Value) / 50000) * 50000 [C3] = Round((Range("C3").Value) / 50000) * 50000 End Sub

birden fazla isimlileri harcamalarıyla birlikte tek isim altında toplatma

ID : 455
ISLEM : birden fazla isimlileri harcamalarıyla birlikte tek isim altında toplatma
MAKRO KODU : ‘Kodlarınızın 2.satırdan başladığını kabul ettim, 1.satırdan başlamaması menfatiniz icabıdır ’Veriler Sheet1 de A sütununda isimler, B sütununda değerleri, ’Sonuçlar sheet2 ye A ve B sütununa yazılıyor. Sub a() Dim isim, deger As Variant Dim rng As Range Dim i, z As Integer i = 2 z = 1 Do If Cells(i, 1).Value = "" Then GoTo bitti If Range([A1], [A10000]).Find(What:=Cells(i, 1).Value, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows).Row -

birden fazla sayfalara koruma koyma/kaldırma

ID : 456
ISLEM : birden fazla sayfalara koruma koyma/kaldırma
MAKRO KODU : Sub KorumaKaldir() Dim ws As Worksheet For Each ws In Worksheets ws.Unprotect ("a") Next End Sub Sub KorumaKoy() Dim ws As Worksheet For Each ws In Worksheets ws.Protect ("a") Next End Sub

birden fazla textboxların özelliklerin değiştirmek

ID : 457
ISLEM : birden fazla textboxların özelliklerin değiştirmek
MAKRO KODU : UserForm un Initialize olayına da yazabilirsiniz Private Sub CommandButton1_Click() Dim Ctr As Control Dim Say As Integer Say = 0 For Each Ctr In Controls If TypeName(Ctr) = "TextBox" Then Say = Say + 1 With Controls("TextBox" & (Say)).Font .Bold = 1 .Size = 12 .Name = "Verdana" .Italic = 1 End With Next End Sub

birden fazla textboxların özelliklerin değiştirmek

ID : 458
ISLEM : birden fazla textboxların özelliklerin değiştirmek
MAKRO KODU : UserForm un Initialize olayına da yazabilirsiniz Public Ctr As Control, Say As Integer Private Sub CommandButton1_Click() Say = 0 For Each Ctr In Controls If TypeName(Ctr) = "TextBox" Then Say = Say + 1 With Controls("TextBox" & (Say)) .Font.Bold = 1 .Font.Size = 12 .Font.Name = "Verdana" .Font.Italic = 1 .BackColor = &HC0FFC0 .ForeColor = &HFF& End With Next End Sub

birleştir penceresi

ID : 459
ISLEM : birleştir penceresi
MAKRO KODU : Sub Dialog_15() Application.Dialogs(xlDialogConsolidate).Show End Sub

birleştirilmiş hücrede makro uygulama

ID : 460
ISLEM : birleştirilmiş hücrede makro uygulama
MAKRO KODU : Private Sub CommandButton1_Click() For a=1 To sheets.count For Each hucre In sheets(a).[a1:e20] If hucre.Interior.Color = vbYellow Then If hucre.MergeCells = True Then sheets(a).select hucre.Select Selection.ClearContents Else hucre.ClearContents End If End If Next Next End Sub

birleştirilmiş hücreleri kırmızı yapar

ID : 461
ISLEM : birleştirilmiş hücreleri kırmızı yapar
MAKRO KODU : Sub Verbundene_Zellen() Dim cell As Range For Each cell In ActiveSheet.UsedRange If cell.MergeCells = True Then cell.Interior.ColorIndex = 3 Next End Sub

boş hücreler yeşil olur

ID : 462
ISLEM : boş hücreler yeşil olur
MAKRO KODU : Sub BackgroundColors() For Each cell In Range("a1:a10") If Not IsError(cell.Value) Then With cell.Interior Select Case cell.Value Case Is = Empty .ColorIndex = 10 Case Is = "?" .ColorIndex = 6 Case Else .ColorIndex = 0 'xlAutomatic End Select End With Else cell.Interior.ColorIndex = xlAutomatic End If Next cell End Sub

boş hücreyi bir üstteki hücre ile ayni yapmak

ID : 463
ISLEM : boş hücreyi bir üstteki hücre ile ayni yapmak
MAKRO KODU : Sub dene() For i = 2 To 1200 If Cells(i, 1) = "" Then Range(Cells(i - 1, 1), Cells(i - 1, 5)).Copy Cells(i, 1).PasteSpecial End If Next i End Sub

boş olan satırları gizle

ID : 464
ISLEM : boş olan satırları gizle
MAKRO KODU : Sub satirgizle() Dim i As Integer For i = 1 To 15 If Sheets("Sayfa1").Cells(i, 1).Value "" Then Rows(i).Hidden = False Else Sheets("Sayfa1").Rows(i).Hidden = True End If Next i End Sub -

boş olan sütunları gizle

ID : 465
ISLEM : boş olan sütunları gizle
MAKRO KODU : Sub sütungizle() Dim i As Integer For i = 1 To 15 If Sheets("Sayfa1").Cells(i, 1).Value "" Then Column(i).Hidden = False Else Sheets("Sayfa1").Column(i).Hidden = True End If Next i End Sub -

boş olanları silerek doluları yukarı çekme

ID : 466
ISLEM : boş olanları silerek doluları yukarı çekme
MAKRO KODU : Sub listele() For x = [b65526].End(3).Row To 2 Step -1 If Cells(x, 2).Value -

boş satır silme

ID : 467
ISLEM : boş satır silme
MAKRO KODU : Sub bossatirsil() For a = 1 To Sheets.Count sat = Sheets(a).Cells.SpecialCells(xlCellTypeLastCell).Row sut = Sheets(a).Cells.SpecialCells(xlCellTypeLastCell).Column For b = sat To 1 Step -1 If WorksheetFunction.CountA(Sheets(a).Rows(b)) = 0 Then Sheets(a).Rows(b).Delete Next For c = sut To 1 Step -1 If WorksheetFunction.CountA(Sheets(a).Columns(c)) = 0 Then Sheets(a).Columns(c).Delete Next Next End Sub

boş satır silme2

ID : 468
ISLEM : boş satır silme2
MAKRO KODU : Sub sil() For x = [b65526].End(3).Row To 2 Step -1 If Cells(x, 2).Value -

boş satırları gizlemek

ID : 469
ISLEM : boş satırları gizlemek
MAKRO KODU : Sub Gizle() For Each t In Range("C9:C85").Cells If t.Value = "" Then 'boş hücreleri gizler t.EntireRow.Hidden = True End If Next t End Sub Sub Göster() For Each t In Range("C9:C85").Cells If t.Value = "" Then 'boş hücreleri gösterir t.EntireRow.Hidden = False End If Next t End Sub

boş satırları iptal etmek

ID : 470
ISLEM : boş satırları iptal etmek
MAKRO KODU : Sub Bul_Sil() Dim hucre As Range For Each hucre In Range("B5:B25") Application.StatusBar = hucre.Address(False, False) '_______1 nci ALTERNATİF (GİZLEME)_______ If hucre.Value = "" Then hucre.EntireRow.Hidden = True '_______2 nci ALTERNATİF (SİLME)_______ 'If hucre.Value = "" Then hucre.Delete Shift:=xlUp Next hucre Application.StatusBar = False End Sub

boş satirlar listbox'ta listelenmesin.

ID : 471
ISLEM : boş satirlar listbox'ta listelenmesin.
MAKRO KODU : Private Sub UserForm_Initialize() dolu_son_satır = Sheets("Sevkiyat").Cells(65536, "A").End(xlUp).Row ListBox1.RowSource = "Sevkiyat!A6:I" & dolu_son_satır ListBox1.ColumnHeads = True ListBox1.ColumnCount = 9 ListBox1.ListIndex = 0 Satirsayisi = ListBox1.ListCount Label12.Caption = Satirsayisi End Sub

boş satirlari silmek

ID : 472
ISLEM : boş satirlari silmek
MAKRO KODU : Sub auto_close() Range("A:A").Select Selection.SpecialCells(xlCellTypeBlanks).Select Selection.EntireRow.Delete Range("A1").Select End Sub

boşluk aldırma

ID : 473
ISLEM : boşluk aldırma
MAKRO KODU : Sub DeleteEmptyRows() LastRow = ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete Next r End Sub

boşlukları aldırma

ID : 474
ISLEM : boşlukları aldırma
MAKRO KODU : Option Explicit Sub Leerzeilenlöschen() Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete End Sub

boşlukları aldırmak (silerek)

ID : 475
ISLEM : boşlukları aldırmak (silerek)
MAKRO KODU : Sub DeleteEmptyRows() LastRow = ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete Next r End Sub

bu ayın günlerini sağa doğru yazma, alt hücreye gününü yazma ve haftasonlarını renklendirme

ID : 476
ISLEM : bu ayın günlerini sağa doğru yazma, alt hücreye gününü yazma ve haftasonlarını renklendirme
MAKRO KODU : Sub Ayarla() Dim Ayin_Ilk_Gunu As Date, Ayin_Son_Gunu As Date, Hedef As Range, Adres As String Ayin_Ilk_Gunu = DateSerial(Year(Now), Month(Now), 1) Ayin_Son_Gunu = DateSerial(Year(Now), Month(Now) + 1, 1) - 1 On Error Resume Next ActiveWorkbook.Names("Bayramlar").Delete On Error GoTo 0 ActiveWorkbook.Names.Add Name:="Bayramlar", RefersToR1C1:= _ "={" & CDbl(CDate("23.04.2007")) & ";" & CDbl(CDate("19.05.2007")) & ";" & CDbl(CDate("23.10.2007")) & ";" & CDbl(CDate("24.10.2007")) & ";" & CDbl(CDate("25.10.2007")) & ";" & _ CDbl(CDate("29.10.2007")) & ";" & CDbl(CDate("31.12.2007")) & ";" & CDbl(CDate("01.01.2008")) & ";" & CDbl(CDate("02.01.2008")) & ";" & CDbl(CDate("03.01.2008")) & "}" Set Hedef = Range("A5") Hedef = Ayin_Ilk_Gunu Hedef.NumberFormat = "DD" With Hedef Adres = .Address(True, False) .Select .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:= _ "=VE(" & Adres & """"";YADA(DEĞİL(EHATALIYSA(DÜŞEYARA(" & Adres & ";Bayramlar;1;0)));HAFTANINGÜNÜ(" & Adres & ";2)=6;HAFTANINGÜNÜ(" & Adres & ";2)=7))" .FormatConditions(1).Interior.ColorIndex = 3 End With With Hedef(2, 1) .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:= _ "=VE(" & Adres & """"";YADA(DEĞİL(EHATALIYSA(DÜŞEYARA(" & Adres & ";Bayramlar;1;0)));HAFTANINGÜNÜ(" & Adres & ";2)=6;HAFTANINGÜNÜ(" & Adres & ";2)=7))" .FormatConditions(1).Interior.ColorIndex = 3 End With Hedef.DataSeries Rowcol:=xlRows, Type:=xlChronological, Date:=xlDay, _ Step:=1, stop:=CDbl(Ayin_Son_Gunu), Trend:=False Hedef.AutoFill Destination:=Range(Hedef, Hedef.End(xlToRight)), Type:=xlFillDefault Hedef(2, 1) = Format(Hedef(1, 1), "DDD") Hedef(2, 1).AutoFill Destination:=Range(Hedef(2, 1), Hedef.End(xlToRight)(2, 1)), Type:=xlFillDefault Range(Hedef(2, 1).EntireColumn, Hedef.End(xlToRight)(2, 1).EntireColumn).Columns.AutoFit Hedef(3, 1).Formula = "=IF(AND(OR(WEEKDAY(" & Adres & ",2)=1,WEEKDAY(" & Adres & ",2)=3,WEEKDAY(" & Adres & ",2)=5),ISERROR(VLOOKUP(" & Adres & ",Bayramlar,1,0))),10,IF(AND(OR(WEEKDAY(" & Adres & ",2)=2,WEEKDAY(" & Adres & ",2)=4),ISERROR(VLOOKUP(" & Adres & ",Bayramlar,1,0))),4,0))" Hedef(3, 1).AutoFill Destination:=Range(Hedef(3, 1), Hedef.End(xlToRight)(3, 1)), Type:=xlFillDefault Set Hedef = Nothing End Sub -

bugün yılın kaçıncı haftası (formülle)

ID : 477
ISLEM : bugün yılın kaçıncı haftası (formülle)
MAKRO KODU : ‘Formülü A1 e kadar =NSAT((A1-HAFTANINGÜNÜ(A1;2)-TARİH(YIL(A1+4-HAFTANINGÜNÜ(A1;2));1;-10))/7)

bul komutu aktif sayfada

ID : 478
ISLEM : bul komutu aktif sayfada
MAKRO KODU : Sub Test() ActiveSheet.UsedRange.Select Application.CommandBars.FindControl(ID:=1849).Execute End Sub

bul komutu bütün sayfalarda

ID : 479
ISLEM : bul komutu bütün sayfalarda
MAKRO KODU : Sub Test2() For i = 1 To Worksheets.Count Sheets(i).Select Sheets(i).UsedRange.Select Application.CommandBars.FindControl(ID:=1849).Execute Next End Sub

bul makrosu

ID : 480
ISLEM : bul makrosu
MAKRO KODU : Sub DoBox() ActiveSheet.Cells.Find What:="", LookAt:=xlWhole Application.CommandBars("Worksheet Menu Bar").FindControl( _ ID:=1849, recursive:=True).Execute End Sub

* Görseller ve İçerik tekif hakkına sahip olabilir