Excel'le Adım Adım Program Yazma

A1 1 ise b1 mart  yaz

sayfanın kod kısmına
Private Sub Worksheet_Change(ByVal Target As Range)
 If Range("a1") = 1 Then
Range("b1") = "Mart"
End If
End Sub

A1 10 karakterden fazla ise mesaj ver


Sub testNbCaractere()
CellTest = Range("a1").Value
If Len(CellTest) > 10 Then
MsgBox "Pas plus de 10 caractères", vbOKOnly, "Erreur de caractères"
Exit Sub
End If
End Sub

A1 boş ise (silersen) 10 yapar

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$A$1" And IsEmpty(Target) = True Then Target = "10"
End Sub

A1 de adı yazan sayfayı açar.


Sayfa1'de A1 hücresinde "Sayfa2" yazsın. Aşağıdaki kodu kullanın.
 
Worksheets(Range("A1").Value).Select

Eğer Value'yu eklemezseniz kod çalışmayabilir. Value yerine Text' de yazabilirsiniz.

Eğer bu kodu başka sayfadan çalıştıracaksanız yani Sayfa1'de değilken çalıştıracaksanız aşağıdaki kodu kullanmalısınız.

Worksheets(Worksheets("Sayfa1").Range("A1").Text).Select

Böyle durumlarda genelde kodun kısa ve anlaşılabilir olması için sayfalara set atamasını yapmanızı tavsiye ederim.

Sub SayfaAc()
  Set s1 = Worksheets("Sayfa1")
  Worksheets(s1.Range("A1").Text).Select
End Sub

A1 de kritere göre filtreleme (süz işlemi)

Range("A1").AutoFilter Field:=1, Criteria1:=">2", Operator:=xlAnd, Criteria2:="<

A1 de şartlı sayı verme


Sub SelonCas()
Nombre = ActiveCell.Value
Select Case Nombre
Case 1 To 5
Range("A1").Value = 0
Case 6, 7, 8, 9, 10
Range("A1").Value = 1
Case Else
Range("A1").Value = 1000
End Select
End Sub

A1 deki formülü öğrenme


‘=A1 yaz A1 deki formülü yazsın

Function formul_al(hucre)
If Left(hucre.Formula, 1) = "=" Then _
    formul_al = Right(hucre.Formula, Len(hucre.Formula) - 1) Else _
    formul_al = ""
End Function

A1 deki isimle farklı kaydet


Sub Speichern()
test = Application.GetSaveAsFilename([a1])
If test = False Then Exit Sub
ActiveWorkbook.SaveAs test
End Sub

A1 deki isimle yeni sayfa + aynısı var ikazı

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 deki isimle yeni sayfa oluşturma

Sub Test()
    Set NewSh = Worksheets.Add(After:=Sheets(Sheets.Count))
    NewSh.Name = Sheets("Sayfa1").Range("A1")
    Set NewSh = Nothing
End Sub

A1 deki isimleri listboxta sıralı olarak gösterir

Sub List_Alphab()
    Dim i As Integer, j As Integer
    Dim Entree As String
    Dim Cel As Range
    Set Cel = Range("A1")
    'Pour chaque enregistrement
    For i = 0 To Cel.End(xlDown).Row - 1
        'Récupère la valeur
        Entree = Cel.Offset(i)
        With UserForm1
            'Pour chaque valeur de la listBox
            For j = 0 To .ListBox1.ListCount - 1
                'Si la valeur de la listbox est > à la valeur à entrer
                'on récupère l'index j et on sort de la boucle
                If .ListBox1.List(j) > Entree Then
                    Exit For
                End If
            Next j
            'ajout de la valeur à son emplacement spécifié par l'index j
            .ListBox1.AddItem Entree, j
        End With
    Next i
    UserForm1.Show
End Sub

A1 deki kelimeyi sesli ve sessiz olarak ayırır

Sub Cons_Voy()
    Dim i As Integer
    Dim Chaine As String
    Dim Caract As String * 1
    Dim Conson As String, Voyel As String
    Chaine = Range("A1")
    For i = 1 To Len(Chaine)
        Caract = Mid(Chaine, i, 1)
        Select Case LCase(Caract)
            Case "a", "e", "i", "o", "u", "y"
            Voyel = Voyel & Caract
            Case Else
            Conson = Conson + Caract
        End Select
    Next i
    Range("A2") = Conson
    Range("A3") = Voyel
End Sub

A1 den itibaren ne kadar sayfa varsa yazar

Sub Blattname()
    i = 1
    For Each Blatt In Sheets
        Range("A" & i) = Blatt.Name
        i = i + 1
    Next
End Sub

A1 den itibaren veri olan hücreye kadar seçer

Sub SelectActiveArea()
    Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Select
End Sub

A1 den itibaren verili hücrelere 1 er satır ekler


Sub ValMaxi()
    Dim i As Integer
    i = 1
    Do While Range("A1").Offset(i) <> ""
        Rows(i + 1).Insert
        i = i + 2
    Loop
End Sub