Excel'le Adım Adım Program Yazma

Combobox' kutusundan  textbox' kutusuna  veri aktarabilirsiniz.

Private Sub ComboBox1_Click()
    TextBox1 = ComboBox1.Column(0)
    TextBox2 = ComboBox1.Column(1)
    TextBox3 = ComboBox1.Column(2)

End Sub
Private Sub UserForm_Activate()
With UserForm1.ComboBox1
    .AddItem "kitap"
    .AddItem "kalem"
    .AddItem "silgi"
   End With
End Sub

Bir Listbox'tan başka bir Listbox'a veri taşıyabilirsiniz.

Private Sub UserForm_Initialize()
    ListBox1.RowSource = "A1:A" & Cells(65536, 1).End(xlUp).Row
    ListBox1.ListStyle = fmListStyleOption
    ListBox1.MultiSelect = fmMultiSelectMulti
End Sub
'
Private Sub CommandButton1_Click()
    ListBox2.Clear
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ListBox2.AddItem ListBox1.List(i)
        End If
    Next
End Sub

Excel de sayfadaki e-mail adreslerinin ayıklanması makrosu

Sub ayikla()
    For x = 1 To [a65536].End(3).Row
    d = Split(Cells(x, 1))
        For Each elem In d
            If InStr(elem, "@") Then
                a = a + 1
                Sheets("sayfa2").Cells(a, 1) = Trim(Replace(Replace(Replace(elem, ",", ""), "e-mail:", ""), Chr(160), ""))
            End If
        Next elem
    Next x
        Sheets("sayfa2").Select
End Sub

Excel'de basit bir hesap makinası
Bunun için formunuza 3 adet textbox 4 adet option nesnesi yerleştirmeniz gerekiyor.1. textbox birinci degeri almamıza 2. textbox  ikinci değeri almamıza 3.textbox ise işlem sonucunu göstermemize yarıyacak.Option nesneleride hangi işlemi yapacağımızı seçmemize yarayacak.



Private Sub Command1_Click()
Dim sayı1, sayı2, sonuc As integer
deger1 = Val(Text1.Text)
deger2 = Val(Text2.Text)
If Option1 = True Then sonuç = deger1 + deger2
If Option2 = True Then sonuç = deger1 - deger2
If Option3 = True Then sonuç = deger1 * deger2
If Option4 = True Then sonuç = deger1 /  deger2
Text3.Text = Str(sonuc)
End Sub

Excel macro ile not defterini açabilirsiniz.

Sub notpad()
Call Shell("notepad.exe.", 1)
End Sub

Rastgele sayı üretme 1
Bu kod excel kod parçacığı "B1" hücresine 0 ile 100 arasında rastgele tamsayı atar.


Sub rastgele()
    Dim sayi As Integer
    Randomize
    sayi = Int((100 * Rnd) + 1)
    Range("B1") = sayi
End Sub

Excel'de satır ve sütün genişliğini ayarlayan makro
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Set rng = Columns("C:C")
If Not (Intersect(Target, rng) Is Nothing) Then
rng.ColumnWidth = 30
Else
rng.ColumnWidth = 10.71
End If
End Sub

Excelde saat farkı hesaplayabilirsiniz.

Sub fark()
Cells(3, 3) = "=NOW()"
Cells(3, 3).Select
Selection.NumberFormat = "h:mm"
Cells(3, 4) = Cells(3, 3).Value - Cells(3, 2).Value
Range("E1").Select
End Sub

excel vba saat tarih fonksiyonunu kullanımına bir örnek

LABEL KUTULARINA SAAT&TARİH EKLER

Private Sub tarih_Click()
Label1.Caption = time
Label2.Caption = Date
End Sub
'TARİH&SAAT'İ AYNI ANDA GÖSTERİR.
Private Sub Label3_Click()
Label1.Caption = Now()
End Sub

excel vba sayfaya parola koruması koyma

Sub sifrele()
Dim sht As Worksheet
Dim MotPass
sifre = InputBox("Lütfen bir şifre yazınız", 2)

For Each sht In ActiveWorkbook.Worksheets
sht.Protect Password:=(sifre), Contents:=True, _
DrawingObjects:=True, Scenarios:=True
Next sht
End Sub

Tekrarlayan kayıtları silen macro
Sub tekrarli_kayit_sil()
Cells.Sort Key1:=Range("A1")
toplam_satir = ActiveSheet.UsedRange.Rows.Co unt
sayac = 1
For Row = toplam_satir To 2 Step -1
  If Cells(Row, 1).Value = Cells(Row - 1, 1).Value Then
     Rows(Row).Delete
sayac = sayac + 1
End If
Next Row
End Sub

Sayfa Silerken Uyarı Gelmemesi

Sub Sil()
    Application.DisplayAlerts = False
    ActiveSheet.Delete
End Sub

'Çıkışta Eski Haline Getirir.
Sub Auto_Close()
    Application.DisplayAlerts = True
End Sub

"A1:M8" hücrelerinin arkaplani yanip söner

Sub FlashBack()
'Make cell range Background color, flash x times, x fast, in x color,
'when Ctrl-a is pressed.
Dim newColor As Integer
Dim myCell As Range
Dim x As Integer
Dim fSpeed
'Make this cell range background flash!
Set myCell = Range("A1:M8")
Application.DisplayStatusBar = True
Application.StatusBar = "... Select Cell to Stop and Edit or Wait for Flashing to Stop! "
'Make cell background flash to this color!
'Black 25, Magenta 26, Yellow 27, Cyan 28, Violet 29, Dark Red 30,
'Teal 31, Blue 32, White 2, Red 3, Light Blue 41, Dark Blue 11,
'Gray-50% 16, Gray-25% 15, Bright Cyan 8.
newColor = 11
'Make the cell range flash fast: 0.01 to slow: 0.99
fSpeed = 0.2
'Make cell flash, this many times!
Do Until x = 2
'Run loop!
DoEvents
Start = Timer
Delay = Start + fSpeed
Do Until Timer > Delay
DoEvents
myCell.Interior.ColorIndex = newColor
Loop
Start = Timer
Delay = Start + fSpeed
Do Until Timer > Delay
DoEvents
myCell.Interior.ColorIndex = xlNone
Loop
x = x + 1
Loop
Application.StatusBar = False
Application.DisplayStatusBar = Application.DisplayStatusBar
End Sub

0 olan hücreleri geri alma

Type SaveRange
        Val As Variant
        Addr As String
    End Type
   
'   Stores info about current selection
    Public OldWorkbook As Workbook
    Public OldSheet As Worksheet
    Public OldSelection() As SaveRange


Sub ZeroRange()
'   Inserts zero into all selected cells

'   Abort if a range isn't selected
    If TypeName(Selection) <> "Range" Then Exit Sub
   
'   The next block of statements
'   Save the current values for undoing
    ReDim OldSelection(Selection.Count)
    Set OldWorkbook = ActiveWorkbook
    Set OldSheet = ActiveSheet
    i = 0
    For Each cell In Selection
        i = i + 1
        OldSelection(i).Addr = cell.Address
        OldSelection(i).Val = cell.Formula
    Next cell
           
'   Insert 0 into current selection
    Application.ScreenUpdating = False
    Selection.Value = 0
   
'   Specify the Undo Sub
    Application.OnUndo "Undo the ZeroRange macro", "UndoZero"
End Sub


Sub UndoZero()
'   Undoes the effect of the ZeroRange sub
   
'   Tell user if a problem occurs
    On Error GoTo Problem

    Application.ScreenUpdating = False
   
'   Make sure the correct workbook and sheet are active
    OldWorkbook.Activate
    OldSheet.Activate
   
'   Restore the saved information
    For i = 1 To UBound(OldSelection)
        Range(OldSelection(i).Addr).Formula = OldSelection(i).Val
    Next i
    Exit Sub

'   Error handler
Problem:
    MsgBox "Can't undo"
End Sub
Other examples of Undo

0 Sıfırın tüm çalışma kitabında gösterilmemesi

Option Explicit

Sub Auto_Open()
    Dim sht As Worksheet
    For Each sht In Worksheets
      sht.Activate
      ActiveWindow.DisplayZeros = False
    Next sht
End Sub

Sub Auto_Close()
    Dim sht As Worksheet
    For Each sht In Worksheets
      sht.Activate
      ActiveWindow.DisplayZeros = True
    Next sht
End Sub

Sub BaskaBirYöntem()
  Dim byt As Byte
  For byt = 1 To Worksheets.Count
    Worksheets(byt).Activate
    ActiveWindow.DisplayZeros = False
  Next byt
End Sub