Excel'le Adım Adım Program Yazma

A1:A10 hücreleri arasında 10 olanları 21 yapar
Sub degistir()
   Dim CurCell As Range
   For Each CurCell In Range("A1:A10")
      If CurCell.Value = 10 Then CurCell.Value = 21
   Next
End Sub

A1:a10 hücreleri arasındaki boş hücreleri yeşile boyar

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

A1:a10 topla mesaj ver toplamını a11 e yaz .


Sub SommePositive()
For Each Cell In Range("A1:A10")
If Cell.Value > 0 Then
total = total + Cell
End If
Next
MsgBox "Total des valeurs positives " & total
Range("A11") = total
End Sub

A1:a30 sınıf adı, b1-b30 sınıfı 2 comboboxta gösterimi


Private Sub ComboBox1_Change()
ComboBox2 = ""
If ComboBox1 = "1 A Sınıfı" Then
ComboBox2.RowSource = "1!b2:b40"
ElseIf ComboBox1 = "1 B Sınıfı" Then
ComboBox2.RowSource = "1!d2:d40"
ElseIf ComboBox1 = "1 C Sınıfı" Then
ComboBox2.RowSource = "1!f2:f40"
End If
End Sub

Private Sub UserForm_Initialize()
ComboBox1.MatchEntry = fmMatchEntryComplete
ComboBox2.MatchEntry = fmMatchEntryComplete
ComboBox1.AddItem "1 A Sınıfı"
ComboBox1.AddItem "1 B Sınıfı"
ComboBox1.AddItem "1 C Sınıfı"
End Sub

A1:A5 e sayı yaz c1 e de bunların toplamı 100 değilse uyarı verir.

Option Explicit

Private Sub Worksheet_Calculate()
'   Target value:
    Const lVal As Long = 100
    Dim rCell As Range
'   Put the cell you want to look at here
'   Cell must be a formula!!
    Set rCell = Range("C1")
'   If the target cells value rises above the specified target value,
    If rCell.Value > lVal Then
'       then deliver a message
        MsgBox "Target value is above " & lVal, 16, "Too High!"
'       And step backwards
        Application.Undo
    End If
'   Explicitly clear memory
    Set rCell = Nothing
End Sub

A1:A5 e sayı yaz c1 e de bunların toplamı 100 ise uyarı verir.

Option Explicit

Private Sub Worksheet_Calculate()
'   Target value:
    Const lVal As Long = 100
    Dim rCell As Range
'   Put the cell you want to look at here
'   Cell must be a formula!!
    Set rCell = Range("C1")
'   If the target cells value equals the specified target value,
    If rCell.Value = lVal Then
'       then deliver a message
        MsgBox "Target value of " & lVal & " has been achieved", 64, "Target Met!"
    End If
'   Explicitly clear memory
    Set rCell = Nothing
End Sub

A1:A5 e sayı yaz c1 e de bunların toplamı 100den aşağı ise uyarı verir.


Option Explicit

Private Sub Worksheet_Calculate()
'   Target value:
    Const lVal As Long = 100
    Dim rCell As Range
'   Put the cell you want to look at here
'   Cell must be a formula!!
    Set rCell = Range("C1")
'   If the target cells value drops below the specified target value,
    If rCell.Value < lVal Then
'       then deliver a message
        MsgBox "Target value is below " & lVal, 16, "Target too Low!"
'       And step backwards
        Application.Undo
    End If
'   Explicitly clear memory
    Set rCell = Nothing
End Sub

A1:a5 verileri ile birlikte ait olunan ay ve yıl isimli yeni sayfa ekler.


Sub Add_Sheet()
Dim wSht As Worksheet
Dim shtName As String
shtName = Format(Now, "mmmm_yyyy")
For Each wSht In Worksheets
    If wSht.Name = shtName Then
        MsgBox "Sheet already exists...Make necessary " & _
            "corrections and try again."
        Exit Sub
    End If
Next wSht
    Sheets.Add.Name = shtName
    Sheets(shtName).Move After:=Sheets(Sheets.Count)
    Sheets("Mahmut").Range("A1:A5").Copy _
        Sheets(shtName).Range("A1")
End Sub

A1:a50 ad soyadları textboxta arat listboxta listele

Private Sub CommandButton1_Click()
  Dim i As Integer
 
  ListBox1.Clear
  For i = 1 To 50
    If StrConv(Cells(i, 1), vbUpperCase) = StrConv(TextBox1, vbUpperCase) Then
        ListBox1.AddItem Cells(i, 1).Text & " - " & Cells(i, 1).Address(False, False)
    End If
  Next i
End Sub

A1:a50 adları textboxta arat listboxta listele

Private Sub CommandButton2_Click()
  Dim i As Integer
  Dim say As Integer
   
    ListBox1.Clear
    Set isim = Range("A1:A50").Find(TextBox1)
    If Not isim Is Nothing Then
      ilk = isim.Address
      Do
        ListBox1.AddItem isim & " - " & isim.Address(False, False)
        Set isim = Range("A1:A50").FindNext(isim)
      Loop While Not isim Is Nothing And isim.Address <> ilk
    End If
End Sub

A1:b10 hücrelerine ad tanımlar

Sub AddName1()
ActiveSheet.Names.Add Name:="MyRange1", RefersTo:="=$A$1:$B$10"
End Sub

A1:b5 arasına tıklayınca açılan userform 1

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row < 6 And Target.Column < 3 Then
UserForm1.Show
End If
End Sub

A1:b5 arasına tıklayınca açılan userform 2


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set MyIsect = Application.Intersect(Target, Range("A1:B5"))
    If Not MyIsect Is Nothing Then UserForm1.Show
End Sub

A1:c10 arası veri girilince e1:e10 arasına tarihini ekler


Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("A1:C11")) Is Nothing Then
      Application.EnableEvents = False
      Cells(Target.Row, 5).Value = Date
      Application.EnableEvents = True
   End If
End Sub

A1:d4 ü seç b2 yi active et


Sub MakeActive()
    Worksheets("Sheet1").Activate
    Range("A1:D4").Select
    Range("B2").Activate
End Sub