Excel'le Adım Adım Program Yazma

Çevrimdışı peternorton2

  • Bilge Üye
  • *****
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
# 13 Ara 2014 23:27:58
Yazılan Açıklamayı Gösterir (egitimhane)

sub Macro1()
msgbox "egitimhane"
end Sub

Çevrimdışı peternorton2

  • Bilge Üye
  • *****
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
# 13 Ara 2014 23:29:02
Eğer A1 Hücresinde işlem yapılırsa
 A2 Hücresine değiştirilme tarihi ve saatini yazar

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target = Cells(1, 1) Then Cells(2, 1) = Now
End Sub

alternatif ŞİMDİ() or Bugün or Time

Çevrimdışı peternorton2

  • Bilge Üye
  • *****
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
# 13 Ara 2014 23:31:57
SATIR SÜTUN GİZLEME  İŞLEMLERİ
EĞER AKTİF HÜCRE DEĞERİ 1 DEN BÜYÜK İSE AKTİF HÜCRENİN ALTINA BOŞ SATIR EKLER

Sub InserLSiRupture()
Set x = ActiveCell
Do Until IsEmpty(x)
If x.Row > 1 Then
If x.Offset(-1, 0).Value <> x.Value Then
Rows(x.Row).Insert Shift:=xlDown
End If
End If
Set x = x.Offset(1, 0)
Loop
End Sub

Çevrimdışı peternorton2

  • Bilge Üye
  • *****
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
# 13 Ara 2014 23:32:46
Bir önceki işlem yapılan hücreyi seç

Sub LastCell()
Selection.SpecialCells(xlLastCell).Select
End Sub

Boş Hücreleri Seç

Sub boshucresec()
Selection.SpecialCells(xlCellTypeBlanks).Select
End Sub

Eğer aktif hücreler nümerik (sayı) ise ve 500 den büyükse kalın yap

Sub aktiflestir()
If IsNumeric(ActiveCell) Then
ActiveCell.Font.Bold = ActiveCell.Value >= 500
End If
End Sub

Çevrimdışı peternorton2

  • Bilge Üye
  • *****
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
# 13 Ara 2014 23:33:26
EĞER C1 HÜCRESİ BOŞSA C4 HÜCRESİNİ BOŞALT BOŞ DEĞİLSE C1 HÜCRESİNDEKİ DEĞERİ YAZI

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Address = "$C$4" And Target.Value = "Y" Then
Target.Value = Range("C1").Value
End If
End Sub

Çevrimdışı peternorton2

  • Bilge Üye
  • *****
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
# 13 Ara 2014 23:36:13
VERİLERİ KAYDETME  (Buton)


Private Sub CommandButton5_Click()
    Dim bak As Range
    Dim say As Integer
    For Each bak In Range("A1:A" & WorksheetFunction.CountA(Range("A1:A65000")))
        If bak.Value = ComboBox1.Value Then
            MsgBox "Bu Kayıt numarası bulundu."            Exit Sub
        End If
    Next bak
    For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
        If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then
            MsgBox "Bu isimde bir kaydınız bulundu"            Exit Sub
        End If
    Next bak
    say = WorksheetFunction.CountA(Range("B1:B65000"))
    TextBox1.Value = say
    Cells(say + 1, 1).Value = TextBox1.Value
    Cells(say + 1, 2).Value = ComboBox1.Value
    Cells(say + 1, 3).Value = TextBox2.Value
    Cells(say + 1, 4).Value = TextBox3.Value
    Workbooks("kitap2.XLS").Save
    MsgBox "Verileriniz Kaydedildi", , "KAYIT"        ComboBox1.RowSource = "Veri!B2:B" & say + 1
    TextBox1.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1
Unload UserForm1
    UserForm1.Show
End Sub

BU KOD FORMA YAZILIR

Private Sub UserForm_Initialize()
    Dim say As Integer
    Sheets("Veri").Select
    TextBox1.Locked = True
    If Range("B2") = "" Then
        say = WorksheetFunction.CountA(Range("B1:B65000"))
        ComboBox1.RowSource = "Veri!B2:B" & say + 1
    Else
        say = WorksheetFunction.CountA(Range("B1:B65000"))
        ComboBox1.RowSource = "Veri!B2:B" & say
    End If
    TextBox1.Value = say
    ComboBox1.SetFocus
End Sub

Çevrimdışı peternorton2

  • Bilge Üye
  • *****
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
# 13 Ara 2014 23:37:51
VERİLERİ DEĞİŞTİRİR (DÜZENLEME YAPILANLARI KAYDETME)

Private Sub CommandButton8_Click()
Dim bak As Range
    For Each bak In Range("b1:b" & WorksheetFunction.CountA(Range("b1:b65000")))
        If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then
            bak.Select
    ActiveCell.Value = ComboBox1.Value
    ActiveCell.Offset(0, 1).Value = TextBox2.Value
    ActiveCell.Offset(0, 2).Value = TextBox3.Value
     Workbooks("KİTAP2.XLS").Save
    MsgBox "Verileriniz Başarıyla Değiştirildi", , "KAYIT"
    ComboBox1.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1
      Unload UserForm1
      UserForm1.Show
         Exit Sub
        End If
   Next bak
End Sub

Çevrimdışı peternorton2

  • Bilge Üye
  • *****
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
# 13 Ara 2014 23:41:05
ARAMA   (VERİLERİ BULUR)

Private Sub CommandButton6_Click()
    Dim bak As Range
    For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
        If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then
            bak.Select
            TextBox1.Value = ActiveCell.Offset(0, -1).Value
            TextBox2.Value = ActiveCell.Offset(0, 1).Value
            TextBox3.Value = ActiveCell.Offset(0, 2).Value
            Exit Sub
        End If
    Next bak
    MsgBox "Aradığınız isimde bir kayıt bulunamadı"
End Sub

'VERİ ARATIRKEN SÜTUN SEÇİMİNİ GENİŞ TUTARSAK BÜTÜN SAYFADA VERİ ARATABİLİRİZ.
Private Sub CommandButton1_Click()
    Dim bak As Range
    For Each bak In Range("a1:ıv" & WorksheetFunction.CountA(Range("a1:ıv65000")))
        If StrConv(bak.Value, vbUpperCase) = StrConv(ComboBox1.Value, vbUpperCase) Then
            bak.Select
         
            Exit Sub
        End If
    Next bak
          MsgBox "Aradığınız isimde bir kayıt bulunamadı"
       
End Sub

Çevrimdışı peternorton2

  • Bilge Üye
  • *****
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
# 13 Ara 2014 23:41:55
VERİLERİ SİLME

Private Sub CommandButton7_Click()
    Dim say As Integer
    Dim i As Integer
    Dim bos As Range
    For Each bos In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
        If ComboBox1.Value = "" Or bos = "" Or ActiveCell = "" Then
            MsgBox "Önce aradığınız veriyi BUL ile bulmalısınız"
            Exit Sub
        End If
    Next bos
    Range(ActiveCell.Offset(0, -1).Address(False, False) & ":" & ActiveCell.Offset(0, 2).Address(False, False)).Delete Shift:=xlUp
    say = WorksheetFunction.CountA(Range("A2:A65000"))
    For i = 1 To say
        Cells(i + 1, 1) = i
    Next i
    Workbooks("kitap2.XLS").Save
    MsgBox "Veriniz Silindi", , "KAYIT"
        ComboBox1.RowSource = "Veri!B1:B" & say + 1
    TextBox1.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1
Unload UserForm1
    UserForm1.Show
End Sub

Çevrimdışı peternorton2

  • Bilge Üye
  • *****
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
# 13 Ara 2014 23:42:30
YENİ VERİ GİRMEK İÇİN TABLOYU BOŞALTIR

Private Sub CommandButton5_Click()
Unload Günlük
Günlük.Show
End Sub
'TABLOYU TEMİZLE
Private Sub CommandButton10_Click()
    ComboBox1.Value = ""
    TextBox2.Value = ""
    TextBox3.Value = ""
    ComboBox1.SetFocus
End Sub

Çevrimdışı peternorton2

  • Bilge Üye
  • *****
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
# 13 Ara 2014 23:43:42
BİRDEN FAZLA FORM VAR İSE İSTENEN FORMU ÇAĞIRIR

Private Sub CommandButton6_Click()
Load UserForm1
UserForm1.Show
End Sub

Çevrimdışı peternorton2

  • Bilge Üye
  • *****
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
# 13 Ara 2014 23:46:28
VERİ GÖRME LİSTE KUTUSU

Private Sub ListBox1_Click()
 TextBox1.Value = ListBox1.Value
End Sub

Çevrimdışı peternorton2

  • Bilge Üye
  • *****
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
# 13 Ara 2014 23:47:05
FORM KUTUSUNDAN LİSTE KUTUSUNA KOMUT VERME

Private Sub UserForm_Click()
 Sheets("günlük").Select
    TextBox1.Value = WorksheetFunction.Count(Range("a2:a65000")) + 1
    TextBox2.SetFocus
   
  L = WorksheetFunction.CountA(Worksheets("günlük").Range("a1:a10000"))
    ListBox1.RowSource = "günlük!a1:a" & L
    ListBox1.ColumnCount = 12
    ListBox1.RowSource = "günlük!a1:l" & L
  ' istatislikler yükleniyor
  Range("b2").Select
    TextBox2.Value = ActiveCell.Offset(0, 0).Value
    TextBox3.Value = ActiveCell.Offset(0, 1).Value
    TextBox4.Value = ActiveCell.Offset(0, 2).Value
    TextBox5.Value = ActiveCell.Offset(0, 3).Value
    TextBox6.Value = ActiveCell.Offset(0, 4).Value
    TextBox7.Value = ActiveCell.Offset(0, 5).Value
    TextBox8.Value = ActiveCell.Offset(0, 6).Value
    TextBox9.Value = ActiveCell.Offset(0, 7).Value
    TextBox10.Value = ActiveCell.Offset(0, 8).Value
    TextBox11.Value = ActiveCell.Offset(0, 9).Value
    TextBox12.Value = ActiveCell.Offset(0, 10).Value
   
End Sub

Çevrimdışı peternorton2

  • Bilge Üye
  • *****
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
# 13 Ara 2014 23:48:07
YAZDIR

AKTİF SAYFAYI YAZDIR.

Private Sub CommandButton7_Click()
    Range("A1").Select
    ActiveWindow.SelectedSheets.P rintOut Copies:=1
    Range("A1").Select
End Sub

Çevrimdışı peternorton2

  • Bilge Üye
  • *****
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
  • 1.584
  • 26.592
  • 4. Sınıf Öğretmeni
# 13 Ara 2014 23:49:15
FORMU KAPATIR
Private Sub CommandButton4_Click()
End
End Sub


 


Egitimhane.Com ©2006-2023 KVKK