Makro Kod Listesi

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

ID : 211
ISLEM : aktif hücre boş ve 0 değilse boş değilse 0 yapar
MAKRO KODU : Sub ResetTest4() For Each n In ActiveSheet.UsedRange If n.Value <> 0 Then n.Value = 0 End If Next n End Sub

ID : 212
ISLEM : aktif hücre renklensin
MAKRO KODU : Kod çalışma sayfasına Private Sub Worksheet_SelectionChange(ByVal Target As Range) Static EskiHucre As Range If Target.Interior.ColorIndex <> xlColorIndexNone Then EskiHucre.Interior.ColorIndex = xlColorIndexNone Exit Sub ElseIf Not EskiHucre Is Nothing Then EskiHucre.Interior.ColorIndex = xlColorIndexNone End If Target.Interior.ColorIndex = 6 Set EskiHucre = Target End Sub

ID : 213
ISLEM : aktif hücre veya seçilen hücrelere ad tanımlar
MAKRO KODU : Sub AddName4() Selection.Name = "MyRange4" End Sub

ID : 214
ISLEM : aktif hücre veya seçilen hücrelere ad tanımlar "my range2"
MAKRO KODU : Sub AddName2() ActiveSheet.Names.Add Name:="MyRange2", RefersTo:="=" & Selection.Address() End Sub

ID : 215
ISLEM : aktif hücrede çift tıkla üst satırların alttoplam formülünü yazsın
MAKRO KODU : Private Sub Worksheet_BeforeDoubleClick(ByVal _ Target As Range, Cancel As Boolean) Cancel = True Range(Target.Offset(-1, 0).End(xlUp), Target).Select Target.Formula = "=SUBTOTAL(9," _ & Selection(1).Address(0, 0) & ":" _ & Selection(Selection.Count - 1).Address(0, 0) & ")" Target.Activate End Sub

ID : 216
ISLEM : aktif hücrede daha küçük değer girdirmez
MAKRO KODU : Dim eski Private Sub Worksheet_Change(ByVal Target As Range) If Target.Value < eski Then MsgBox "Mevcut değerden daha küçük bir değer giremezsiniz!", vbCritical Target.Value = eski End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) eski = Target.Value End Sub

ID : 217
ISLEM : aktif hücrede formül varsa adresini ve formül cinsini verir
MAKRO KODU : Sub ListFormulas() Dim counter As Integer Dim i As Variant Dim sourcerange As Range Dim destrange As Range Set sourcerange = Selection.SpecialCells(xlFormulas) Set destrange = Range("M1") destrange.CurrentRegion.ClearContents destrange.Value = "Address" destrange.Offset(0, 1).Value = "Formula" If Selection.Count > 1 Then For Each i In sourcerange counter = counter + 1 destrange.Offset(counter, 0).Value = i.Address destrange.Offset(counter, 1).Value = "'" & i.Formula Next ElseIf Selection.Count = 1 And Left(Selection.Formula, 1) = "=" Then destrange.Offset(1, 0).Value = Selection.Address destrange.Offset(1, 1).Value = "'" & Selection.Formula Else MsgBox "This cell does not contain a formula" End If destrange.CurrentRegion.EntireColumn.AutoFit End Sub

ID : 218
ISLEM : aktif hücredeki metni harflere (sütunlara 3 er karaktere bölerek ayırır)
MAKRO KODU : Sub AA_Parse_3Letter() 'converts a string in a single cell into tripletts of characters in consecutive cells, assuming one separation character 'e.g. Amino acid sequences in 3-letter-code or nucleotide tripletts 'you can select a range of cells within the

ID : 219
ISLEM : aktif hücredeki metni harflere (sütunlara ayırır)
MAKRO KODU : Sub AA_Parse() 'converts a text string in a single cell into individual characters in consecutive cells 'you can select a range of cells within the same column 'do not select more than one column, cells to the right of this column will be overwritten If S

ID : 220
ISLEM : aktif hücreden 7 satır aşağısını ve 7 satır yukarısını seçer
MAKRO KODU : Sub ResizeRng() Selection.Resize(7, 7).Select End Sub

ID : 221
ISLEM : aktif hücreden aşağısını seçer
MAKRO KODU : Sub SelectDown() Range(ActiveCell, ActiveCell.End(xlDown)).Select End Sub

ID : 222
ISLEM : aktif hücreden aşağıya doğru sayfalara köprü atılır
MAKRO KODU : Sub Tabellennamen_auflisten() Dim i As Integer Dim myRange As Range Set myRange = ActiveCell myRange.Resize(Worksheets.Count).Select If (MsgBox("UYARI: Sayfalara köprü oluşturulacak... !" & vbCrLf & _ Chr(13) & " Emin misin ?", vbYesNo)) _ <> vbYes Then Exit Sub For i = 1 To Worksheets.Count With myRange.Cells(i) .Value = Worksheets(i).Name .Hyperlinks.Add _ Anchor:=myRange.Cells(i), _ Address:="", _ SubAddress:=.Value & "!" & .Address, _ ScreenTip:="Blatt (" & .Value & ")", _ TextToDisplay:=.Value End With Next i myRange.Select MsgBox (" Toplam ") & ThisWorkbook.Worksheets.Count & _ (" Çalışma sayfasına köprü oluşturuldu"), vbOKOnly, ThisWorkbook.Name End Sub

ID : 223
ISLEM : aktif hücreden bir alt hücreye sıçrar
MAKRO KODU : Sub ActivateNextBlankDown() ActiveCell.Offset(1, 0).Select Do While Not IsEmpty(ActiveCell) ActiveCell.Offset(1, 0).Select Loop End Sub

ID : 224
ISLEM : aktif hücreden bir hücre yukarı sıçrar
MAKRO KODU : Sub range_up() Dim Cell As Range For Each Cell In Selection Cell.Select Application.SendKeys "{F2}+{ENTER}", True Next End Sub

ID : 225
ISLEM : aktif hücreden bir sağ hücreye sıçrar
MAKRO KODU : Sub ActivateNextBlankToRight() ActiveCell.Offset(0, 1).Select Do While Not IsEmpty(ActiveCell) ActiveCell.Offset(0, 1).Select Loop End Sub

ID : 226
ISLEM : aktif hücreden itibaren 10 satır aşağıya 100 yazar ve toplar
MAKRO KODU : Sub EnterInfo() Dim i As Integer Dim cel As Range Set cel = ActiveCell For i = 1 To 10 cel(i).Value = 100 Next i cel(i).Value = "=SUM(R[-10]C:R[-1]C)" End Sub

ID : 227
ISLEM : aktif hücreden itibaren b1 deki sayıdan başlayarak 1er sayı artırarak 10 sayı yazar toplar
MAKRO KODU : Sub EnterInfo() Dim i As Integer Dim cel As Range 'Set cel = [B3] Set cel = ActiveCell For i = 1 To 10 cel(i).Value = [B1].Value - 1 + i Next i cel(i).Value = "=SUM(R[-10]C:R[-1]C)" End Sub

ID : 228
ISLEM : aktif hücreden itibaren istediğin sayıda satır ekler
MAKRO KODU : Sub InsertRow() Dim Rng Rng = InputBox("Enter number of rows required.") Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(Rng - 1, 0)).Select Selection.EntireRow.Insert End Sub

ID : 229
ISLEM : aktif hücreden sağa doğru seçer
MAKRO KODU : Sub SelectToRight() Range(ActiveCell, ActiveCell.End(xlToRight)).Select End Sub

ID : 230
ISLEM : aktif hücreden sağa, sola, yukarı, aşağı son hücreye gitme
MAKRO KODU : Sub git() ActiveCell.End(xlDown).Select ' aktif hücreden aşağı doğru son satıra gider End Sub Sub git2() ActiveCell.End(xlUp).Select ' aktif hücreden yukarı doğru ilk satıra gider End Sub Sub git3() ActiveCell.End(xlToLeft).Select ' aktif hücreden sola doğru ilk satıra gider End Sub Sub git4() ActiveCell.End(xlToRight).Select ' aktif hücreden sağa doğru son satıra gider End Sub

ID : 231
ISLEM : aktif hücreden sola doğru seçer
MAKRO KODU : Sub SelectToLeft() Range(ActiveCell, ActiveCell.End(xlToLeft)).Select End Sub

ID : 232
ISLEM : aktif hücreden yukarısını seçer
MAKRO KODU : Sub SelectDown() Range(ActiveCell, ActiveCell.End(xlUp)).Select End Sub

ID : 233
ISLEM : aktif hücrelerdeki metinleri açıklama olarak yazan kodlar
MAKRO KODU : Sub TextIntoComments() Dim cell As Range Selection.ClearComments For Each cell In Intersect(Selection, ActiveSheet.UsedRange) If Trim(cell.Text) <> "" Then cell.AddComment cell.Text cell.Comment.Visible = False cell.Comment.Shape.TextFrame.AutoSize = True

ID : 234
ISLEM : aktif hücreleri renklendirir
MAKRO KODU : BU KODU SAYFA KOD BÖLÜMÜNE YAZARSANIZ AKTİF HÜCRELER RENKLİ OLUR Private Sub Worksheet_SelectionChange(ByVal Target As Range) Static EskiHucre As Range If Target.Interior.ColorIndex <> xlColorIndexNone Then EskiHucre.Interior.ColorIndex = xlColorIndexNone Exit Sub ElseIf Not EskiHucre Is Nothing Then EskiHucre.Interior.ColorIndex = xlColorIndexNone End If Target.Interior.ColorIndex = 37 Set EskiHucre = Target End Sub

ID : 235
ISLEM : aktif hücrenin adresini mesajla öğrenme
MAKRO KODU : Sub Aktive_Zelle() az = ActiveCell.Address MsgBox az End Sub

ID : 236
ISLEM : aktif hücrenin altındaki boş olan satırları siler
MAKRO KODU : Sub bossasil() 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 : 237
ISLEM : aktif hücrenin bulunduğu satır renklensin
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) Cells.Interior.ColorIndex = 0 'Turn off previous use If Cells(1, 1) = "." Then Exit Sub Target.EntireRow.Interior.ColorIndex = 38 End Sub

ID : 238
ISLEM : aktif hücrenin bulunduğu satırı seçer
MAKRO KODU : Sub SelectEntireRow() Selection.EntireRow.Select End Sub

ID : 239
ISLEM : aktif hücrenin bulunduğu sütunu (kolonu) seçer
MAKRO KODU : Sub SelectEntireColumn() Selection.EntireColumn.Select End Sub

ID : 240
ISLEM : aktif hücrenin cinsini bulma
MAKRO KODU : Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Application.IsText(ActiveCell) = True Then MsgBox "Bu hücrede YAZI vardır." Else If ActiveCell = "" Then MsgBox "Bu hücre BOŞ tur." Else End If If ActiveCell.HasFormula Then MsgBox "Bu hücrede FORMÜL vardır" Else End If If IsDate(ActiveCell.Value) = True Then MsgBox "Bu hücrede TARİH vardır" Else End If If IsNumeric(ActiveCell.Value) = True Then MsgBox "Bu hücrede SAYI vardır" Else End If End If End Sub