Excel'le Adım Adım Program Yazma

Aktif hücreden 7 satır aşağısını ve 7 satır yukarısını seçer


Sub ResizeRng()
Selection.Resize(7, 7).Select
End Sub

Aktif hücreden aşağısını seçer


Sub SelectDown()
    Range(ActiveCell, ActiveCell.End(xlDown)).Select
End Sub

Aktif hücreden aşağıya doğru sayfalara köprü atılır

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

Aktif hücreden bir alt hücreye sıçrar

Sub ActivateNextBlankDown()
    ActiveCell.Offset(1, 0).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
    Loop
End Sub

Aktif hücreden bir hücre yukarı sıçrar

Sub range_up()
Dim Cell As Range
For Each Cell In Selection
Cell.Select
Application.SendKeys "{F2}+{ENTER}", True
Next
End Sub

Aktif hücreden bir sağ hücreye sıçrar


Sub ActivateNextBlankToRight()
    ActiveCell.Offset(0, 1).Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(0, 1).Select
    Loop
End Sub

Aktif hücreden itibaren 10 satır aşağıya 100 yazar ve toplar.

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

hücreden itibaren b1 deki sayıdan başlayarak 1er sayı artırarak 10 sayı yazar toplar


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

Aktif hücreden itibaren istediğin sayıda satır ekler

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

Aktif hücreden sağa doğru seçer

Sub SelectToRight()
    Range(ActiveCell, ActiveCell.End(xlToRight)).Select
End Sub

Aktif hücreden sağa, sola, yukarı, aşağı son hücreye gitme.


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

Aktif hücreden sola doğru seçer.

Sub SelectToLeft()
    Range(ActiveCell, ActiveCell.End(xlToLeft)).Select
End Sub

Aktif hücreden yukarısını seçer.

Sub SelectDown()
    Range(ActiveCell, ActiveCell.End(xlUp)).Select
End Sub

Aktif hücrelerdeki metinleri açıklama olarak yazan kodlar

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

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