Excel'le Adım Adım Program Yazma

A1 den sayfa oluşturma


Sub Test2()
    If Not Sheets("Sayfa1").Range("A1") = Empty Then
        For i = 1 To Worksheets.Count
            If Sheets(i).Name = Sheets("Sayfa1").Range("A1") Then
                MsgBox "Bu isimli bir sayfa mevcut..... !"
                Exit Sub
            End If
        Next
        Set NewSh = Worksheets.Add(After:=Sheets(Sheets.Count))
        NewSh.Name = Sheets("Sayfa1").Range("A1")
    End If
    Set NewSh = Nothing
End Sub

A1 den sıra numarası verir veya aktif satır numarasını verir.

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    rowoffset = 0
    Intersect(ActiveCell.EntireRow, Columns("A")).Value = ActiveCell.Row + rowoffset
End Sub

A1 devamlı a2 de toplanacak


Private Sub Worksheet_Change(ByVal Target As Range)
  Static kod
  If Target.Address = "$A$1" Then
    Range("A2").Value = kod + Target
  End If
  kod = Target.Value
End Sub

A1 e değer girince makro kodları çalıştırma

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("a1")) Is Nothing Then
"MAKROCODE"
End If
End Sub

A1 e değer girince 10 ile çarp a2 ye yaz


Sub RecupValeur()
Dim Val1
'Dim Resultat As Integer (pour un résultat en entier)
Val1 = Sheets("Feuil1").[a1].Value
Resultat = Val1 * 10
Sheets("Feuil1").[a2].Value = (Resultat)
MsgBox "Opération effectuée." & Chr(13) & Chr(13) _
& "Résultat :" & CStr(Resultat)
End Sub

A1 e her veri girişinde b1,c1 sırasıyla hep yan kolona artarak yazar.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$A$1" Then
Set actcell = [C1]
Do While actcell <> ""
Set actcell = actcell.Offset(0, 1)
Loop
actcell.Value = Target.Value
End If
End Sub

A1 e kullanıcı adını yazdırma

Sub Username()
Range("A1").Value = Environ("USERNAME")
End Sub

A1 e sadece rakam girer (yazı girince 0 yapar) ve devamlı a1 de toplar.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
      Static dAccumulator As Double
      With Target
         If .Address(False, False) = "A1" Then
            If Not IsEmpty(.Value) And IsNumeric(.Value) Then
               dAccumulator = dAccumulator + .Value
            Else
               dAccumulator = 0
            End If
            Application.EnableEvents = False
            .Value = dAccumulator
            Application.EnableEvents = True
         End If
      End With
   End Sub

A1 e tarihi gir b1 de kaçıncı hafta olduğunu bulsun.

B1 e aşağıdaki formülü gir

=NSAT((A1-HAFTANINGÜNÜ(A1;2)-TARİH(YIL(A1+4-HAFTANINGÜNÜ(A1;2));1;-10))/7)

A1 e veri girildikten sonra 100 e bölünmesi

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
If Target.AddressLocal = "$A$1" Then
Target = Target / 100
End If
Application.EnableEvents = True
End Sub

A1 e veri yazılınca solda üstbilgi ekleme


Private Sub Worksheet_Change(ByVal Target As Range)
If (Target = Range("A1")) Then
Worksheets("Tabelle1").PageSetup.LeftHeader = Range("A1")
End If
End Sub

A1 e yaz b1 de devamlı toplasın

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
      With Target
         If .Address(False, False) = "A1" Then
            If IsNumeric(.Value) Then
               Application.EnableEvents = False
               Range("B1").Value = Range("B1").Value + .Value
               Application.EnableEvents = True
            End If
         End If
      End With
    End Sub

A1 hücre ismiyle farklı kaydetme

Sub saveas()
ActiveWorkbook.SaveAs Filename:="C:\" & ActiveSheet.Range("A1")
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Sheets("Sayfa1").Range("A1") = "" Then
  MsgBox ("Kaydetme işlemi devam edemiyor!" & vbNewLine & _
    "A1 hücresini boş bırakamazsınız."), , "pir"
    Cancel = True
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Sheets("Sayfa1").Range("A1") = "" Then
  MsgBox ("Kaydetme işlemi devam edemiyor!" & vbNewLine & _
    "A1 hücresini boş bırakamazsınız."), , "pir"
    Cancel = True
End If
End Sub

A1 hücresi dolu ise d1 gizle, boş ise göster

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Columns("A:A") <> "" Then
    Columns("D:D").EntireColumn.Hidden = True
        Else
    Columns("D:D").EntireColumn.Hidden = False
End If
End Sub