Textbox'a girilen veriyi kayıt et, bul, değiştir sil işlemlerini yapma

[sirkülasyon]

Abilerim Hayırlı Akşamlar.
şu an dört tane textbox var. Bunlara girdiğim bilgileri 6. satırdan itibaren kaydedecek.
o sağda dört tane buton var. Onlarda B3 te bulunan textboxa girilen isim ne ise onu bulacak, deiştirecek yada silecek.
Silerse satırı komple silecek

Bunun için yardımcı olabilirmisiniz...

 

[Korhan Ayhan]

Merhaba,

Neden sayfada kayıt işlemi için TextBox kullanmayı tercih ettiniz. Anlam veremedim. Direk hücreleri kullanırsanız daha kullanışlı olur.

 

[sirkülasyon]

Aslında abi amacım görsellellik katmakdı. birde form uygulanmadan şu butonlar varya korhan abi ona yüklenecek makroyu çok istiyordum

 

[Korhan Ayhan]

Aşağıdaki kodları deneyiniz.

Private Sub CommandButton1_Click()
    Dim Satir As Long
    Dim Nesne As OLEObject
    
    For Each Nesne In ActiveSheet.OLEObjects
        If Nesne.OLEType = 2 Then
            If TypeOf Nesne.Object Is msforms.TextBox Then
                If Nesne.Object.Value = Empty Then
                    Nesne.Activate
                    MsgBox "Lütfen boş bilgileri tamamlayınız.", vbExclamation
                    Exit Sub
                End If
            End If
        End If
    Next
    
    Satir = Cells(Rows.Count, 1).End(3).Row + 1
    Cells(Satir, 1) = Satir - 5
    Cells(Satir, 2) = TextBox1
    Cells(Satir, 4) = TextBox2
    Cells(Satir, 6) = TextBox3
    Cells(Satir, 8) = TextBox4
    
    Satir = Cells(Rows.Count, 2).End(3).Row
    Select Case Satir
        Case 6
            Cells(6, 1) = 1
        Case 7
            Cells(6, 1) = 1
            Cells(7, 1) = 2
        Case Is > 7
            Cells(6, 1) = 1
            Range("A6").AutoFill Range("A6:A" & Satir), xlFillSeries
    End Select
    
    Temizle
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub

Private Sub CommandButton2_Click()
    Dim Bul As Range
    
    If TextBox1 <> "" Then
        Set Bul = Range("B:B").Find(TextBox1, , , xlWhole)
        If Not Bul Is Nothing Then
            Bul.Select
        End If
    Else
        MsgBox "Lütfen bulmak istediğiniz kayıt bilgisini giriniz!", vbCritical
    End If
End Sub

Private Sub CommandButton3_Click()
    Dim Bul As Range
    
    If TextBox1 = "" Then
        MsgBox "Lütfen değiştirmek istediğiniz kayıt bilgisini giriniz!", vbCritical
        TextBox1.Activate
        Exit Sub
    End If
    
    If MsgBox("İlgili kayıt değiştirilecektir. İşlemi onaylıyor musunuz?", vbCritical + vbYesNo, "Dikkat!") = vbNo Then Exit Sub
    
    Set Bul = Range("B:B").Find(TextBox1, , , xlWhole)
    If Not Bul Is Nothing Then
        Bul.Select
        Cells(Bul.Row, 2) = TextBox1
        Cells(Bul.Row, 4) = TextBox2
        Cells(Bul.Row, 6) = TextBox3
        Cells(Bul.Row, 8) = TextBox4
        
        Satir = Cells(Rows.Count, 2).End(3).Row
        Select Case Satir
            Case 6
                Cells(6, 1) = 1
            Case 7
                Cells(6, 1) = 1
                Cells(7, 1) = 2
            Case Is > 7
                Cells(6, 1) = 1
                Range("A6").AutoFill Range("A6:A" & Satir), xlFillSeries
        End Select
        
        Temizle
        MsgBox "Değişiklik işlemi tamamlanmıştır.", vbInformation
    End If
End Sub

Private Sub CommandButton4_Click()
    Dim Bul As Range, Satir As Long
    
    If TextBox1 = "" Then
        MsgBox "Lütfen silmek istediğiniz kayıt bilgisini giriniz!", vbCritical
        TextBox1.Select
        Exit Sub
    End If
    
    If MsgBox("İlgili kayıt silinecektir. İşlemi onaylıyor musunuz?", vbCritical + vbYesNo, "Dikkat!") = vbNo Then Exit Sub
    
    Set Bul = Range("B:B").Find(TextBox1, , , xlWhole)
    If Not Bul Is Nothing Then
        Bul.EntireRow.Delete
        
        Satir = Cells(Rows.Count, 2).End(3).Row
        Select Case Satir
            Case 6
                Cells(6, 1) = 1
            Case 7
                Cells(6, 1) = 1
                Cells(7, 1) = 2
            Case Is > 7
                Cells(6, 1) = 1
                Range("A6").AutoFill Range("A6:A" & Satir), xlFillSeries
        End Select
        
        Temizle
        MsgBox "İlgili kayıt silinmiştir.", vbInformation
    End If
End Sub

Sub Temizle()
    Dim Nesne As OLEObject
    
    For Each Nesne In ActiveSheet.OLEObjects
        If Nesne.OLEType = 2 Then
            If TypeOf Nesne.Object Is msforms.TextBox Then
                Nesne.Object.Value = Empty
            End If
        End If
    Next
End Sub

 

[sirkülasyon]

Korhan abi Yardımcı olduğun için sağolasın
Ellerinden öperim abi