• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

vba kodu ile excelde satır silme ve düzeltme

Y

yamahato

Altın Üye
Katılım
20 Mayıs 2009
Mesajlar
236
Excel Vers. ve Dili
excel 2007
Kolay gelsin
Bir program hazırlıyorum herzamanki gibi gene takıldım ama şunuda belirtmeliyim ki eskisine göre baya iyiyim.En azından artık bazı hataları yada yanlışları kendim düzeltebiliyorum. Neyse konuya gireyim ABO tıklayınca giriş ekranı çıkıyor giriş ve sonrasında araç tanımlamaya tıklayınca sıkıntıya yaklaşıyoruz.plaka girip bu değince exceldeki çalışma sayfasındaki o plakaya ait bilgiler ekrana geliyor. yada yeni bir plaka ve araç bilgilerini girip kaydet deyince çalışma sayfasına kaydediyor .Soruna gelince 2 tane

1-plakayı girip bul dedikten sonra o plaka ile ilgili bilgileri tanım sil ile tıklayınca silmiyor.Birton kod denedim olmadı.Çalışma sayfasındaki o plakanın ilgili satırı komple silinsin ve alttaki satır üste çıkarken s.nu da bir düşsün istiyorum.
2-plakayı girip bul dedikten sonra o plaka ile ilgili yanlış bilgileri textbox üzerinden düzeltip güncelle tuşuna basınca çalışma sayfasındaki o plakaya ait bilgiler güncellensin istiyorum.
kUSURUMA BAKMAYIN BİRAZ FAZLA OLDU AMA YARDIMLARINIZA GERÇEKTEN İHTİYACIM VAR VE KESİNLİKLE ŞUNU BİLMENİZİ İSTERİM Kİ MESAJ YAZIP YARDIM İSTEYİP HAZIRA KONMUYORUM.Yardımlarınız bana sadece takıldığım yerde yol gösteriyor ve beni bu işi daha iyi yapmak için kamçılıyor.Programımın tamamı bitince zaten paylaşıp görüşlerinizi alacağım.
SAYGILARIMLA
 

Ekli dosyalar

Merhaba,

Aşağıdaki kodları deneyiniz.

CommandButton1 ve CommandButton7 butonlarınıza ait kodlarınıza eklemeler yaptım. Diğer iki butona yeni kod yazdım.

Kod: 
Private Sub CommandButton1_Click()
    Dim Nesne As Control
    For Each Nesne In Controls
        Select Case TypeName(Nesne)
            Case "TextBox"
               Nesne = ""
        End Select
    Next
    TextBox1.SetFocus
End Sub

Kod: 
Private Sub CommandButton6_Click()
    If TextBox1 = "" Then
        TextBox1.SetFocus
        Exit Sub
    End If
    If CDbl(TextBox1) = Cells(ActiveCell.Row, 2) Then
        Onay = MsgBox("Seçili kayıt silinecektir!" & Chr(10) & "İşlemi onaylıyor musunuz?", vbCritical + vbYesNo)
        If Onay = vbNo Then Exit Sub
        ActiveCell.EntireRow.Delete
        If Range("A3") <> "" Then
            Range("A3") = 1
            Range("A3").AutoFill Destination:=Range("A3:A" & Cells(Rows.Count, 1).End(3).Row), Type:=xlFillSeries
        End If
        CommandButton1_Click
    Else
        MsgBox "Kayıt eşleşmiyor. İşleminiz iptal edilmiştir!", vbExclamation
        CommandButton1_Click
    End If
End Sub

Kod: 
Private Sub CommandButton7_Click()
    Set S1 = Sheets("ARAÇ BİLGİ DEPOSU")
    S1.Select
    say = WorksheetFunction.CountIf(S1.[b:b], TextBox1)
    If say = 0 Then
    MsgBox "Giriş yaptığınız plaka kayıtlı değildir. Lütfen önce araç tanımı yapınız.", 32, "Uyarı"
             TextBox1.Value = Empty
             TextBox2.Value = Empty
             TextBox3.Value = Empty
             TextBox4.Value = Empty
             TextBox5.Value = Empty
             TextBox6.Value = Empty
             TextBox7.Value = Empty
             TextBox8.Value = Empty
             TextBox9.Value = Empty
             TextBox10.Value = Empty
             TextBox1.SetFocus
    Exit Sub
    End If
    sat = WorksheetFunction.Match(CDbl(TextBox1), S1.[b:b], 0)
    S1.Cells(sat, "a").Select
    TextBox1 = S1.Cells(sat, "B")
    TextBox2 = S1.Cells(sat, "C")
    TextBox3 = S1.Cells(sat, "D")
    TextBox4 = S1.Cells(sat, "E")
    TextBox5 = S1.Cells(sat, "F")
    TextBox6 = S1.Cells(sat, "G")
    TextBox7 = S1.Cells(sat, "H")
    TextBox8 = S1.Cells(sat, "I")
    TextBox9 = S1.Cells(sat, "J")
    TextBox10 = S1.Cells(sat, "K")
End Sub

Kod: 
Private Sub CommandButton8_Click()
    If TextBox1 = "" Then
        TextBox1.SetFocus
        Exit Sub
    End If
    If CDbl(TextBox1) = Cells(ActiveCell.Row, 2) Then
        Onay = MsgBox("Seçili kayıt bilgileri güncellenecektir!" & Chr(10) & "İşlemi onaylıyor musunuz?", vbCritical + vbYesNo)
        If Onay = vbNo Then Exit Sub
        ActiveCell.Offset(0, 1) = TextBox1
        ActiveCell.Offset(0, 2) = TextBox2
        ActiveCell.Offset(0, 3) = TextBox3
        ActiveCell.Offset(0, 4) = TextBox4
        ActiveCell.Offset(0, 5) = TextBox5
        ActiveCell.Offset(0, 6) = TextBox6
        ActiveCell.Offset(0, 7) = TextBox7
        ActiveCell.Offset(0, 8) = TextBox8
        ActiveCell.Offset(0, 9) = TextBox9
        ActiveCell.Offset(0, 10) = TextBox10
        CommandButton1_Click
    Else
        MsgBox "Kayıt eşleşmiyor. İşleminiz iptal edilmiştir!", vbExclamation
        CommandButton1_Click
    End If
End Sub
 
Korhan bey' in affına sığınarak command_button6 ve 8 click olaylarına alternatif kodlar.
Korhan bey henüz öğrenme aşamasındayım, kod larınız çok ilgimi çekti.İnceleyip anlamaya çalışıcağım :) .

Kod: 
Private Sub CommandButton6_Click()
plaka = TextBox1.Text
If plaka = "" Then
MsgBox "Lütfen öncelikle silinecek plaka numarasını yazıp BUL düğmesine tıklayın"
TextBox1.SetFocus
Exit Sub
End If
sil = MsgBox("Silmek istediğinize emin misiniz ? ", vbYesNo)
If sil = vbYes Then
    Set bul = Range("b3:b" & son).Find(plaka)
        If Not bul Is Nothing Then
            plaka = bul.Row
            Rows(plaka).Delete
                For a = 3 To Range("a65536").End(3).Row
                    Cells(a, "a").Value = a - 2
                Next a
                For a = 1 To 10
                Controls("TextBox" & a).Value = ""
                Next a
        End If
ElseIf sil = vbNo Then
    MsgBox "Hayır tıklandı"
End If
End Sub




Kod: 
Private Sub CommandButton8_Click()
plaka = TextBox1.Text
Set bul = Range("b2:b" & son).Find(plaka)
If bul Is Nothing Then
For a = 1 To 10
Controls("TextBox" & a).Value = ""
Next a
TextBox1.SetFocus
Else
degistir = MsgBox("Bilgileri değiştirmek istediğinize emin misiniz ? ", vbYesNo)
    If degistir = vbYes Then
    plaka = bul.Row
    For a = 1 To 10
    Cells(plaka, a + 1).Value = Controls("TextBox" & a).Value
    Controls("TextBox" & a).Value = Cells(plaka, a + 1).Value
    Next a
    ElseIf degistir = vbNo Then
    MsgBox "Hayır tıklandı"
    End If
End If
End Sub
 
Son düzenleme:
Yardımlarınız için teşekkür ederim
Kodları çalıştırdım bir iki sıkıntı ortaya çıktı

1- bilgiler girilip kaydet butonuna basınca bilgiler çalışma sayfasındaki yerlerine gidiyorlar ama her seferinde S.NU 5 olarak veriyor halbuki 1234 diye gitmesi gerekmekte yazarken bir hata yaptım ama nerde.

2-plaka girilip bul dediğimizde örnek olarak veriyorum 007878(bizdeki plakalar böyle)7878 dönüşüyor.Değişmesine müteakip güncelle dersek çalışma sayfasına plaka 007878 olacağına 7878 olarak gidiyor.

Saygılarımla
 
teşekkürler

verdiğiniz kodların hepsini denedim evet çalışıyorlar ama galiba plaka numaralarının 00 ile başlaması sebebi ile kodlar hep hata mesajı veriyor.
ben baya bir uğraştım düzeltmeye ama ne yazık ki beceremedim belli başlı sıkıntıları yazdım saygılar
Yardımlarınız için teşekkür ederim


1- bilgiler girilip kaydet butonuna basınca bilgiler çalışma sayfasındaki yerlerine gidiyorlar ama her seferinde S.NU 5 olarak veriyor halbuki 1234 diye gitmesi gerekmekte yazarken bir hata yaptım ama nerde.(galiba bunu çözdüm )

2-plaka girilip bul dediğimizde örnek olarak veriyorum 007878(bizdeki plakalar böyle)7878 dönüşüyor.Değişmesine müteakip güncelle dersek çalışma sayfasına plaka 007878 olacağına 7878 olarak gidiyor

3- bul kodları plakaların 00 ile başlamasından dolayı 2 veya 3 aramadan itibaren hep hata veriyor.

Saygılarımla
 

Ekli dosyalar

Dosyanız üzerinde sil ve güncelle butonlarını ayarlarım, diğer butonlarda bir sorun göremedim. Düzenlenmiş dosyanız ektedir.
 

Ekli dosyalar

Alternatif olarak ekteki örnek dosyayı inceleyiniz.
 

Ekli dosyalar

Private Sub CommandButton2_Click()
If TextBox1 = "" Then
TextBox1.SetFocus
Exit Sub
End If
If CDbl(TextBox1) = Cells(ActiveCell.Row, 2) Then
Onay = MsgBox("Seçili kayıt silinecektir!" & Chr(10) & "İşlemi onaylıyor musunuz?", vbCritical + vbYesNo)
If Onay = vbNo Then Exit Sub
ActiveCell.EntireRow.Delete
If Range("A3") <> "" Then
Range("A3") = 1
Range("A3").AutoFill Destination:=Range("A3:A" & Cells(Rows.Count, 1).End(3).Row), Type:=xlFillSeries
End If
CommandButton6_Click
Else
MsgBox "Kayıt eşleşmiyor. İşleminiz iptal edilmiştir!", vbExclamation
CommandButton6_Click
End If
End Sub

Koray abi bu kodda bir yerde bir sıkıntı var ama ne asıl programda bu kod gurubu "Kayıt eşleşmiyor. İşleminiz iptal edilmiştir" diyor ekranı temizliyor gönderdiğin örnek isimli dosyada ise ilk seferde siliyor başka bir plakayı girince silmek için range sinıfının autofill yöntemi başarısız didikten sonra debug tuşuna basınca Range("A3").AutoFill Destination:=Range("A3:A" & Cells(Rows.Count, 1).End(3).Row), Type:=xlFillSeries sarı oluyor
saygılar
 
Merhaba,

Üstteki mesajımdaki dosyayı güncelledim. Denermisiniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst