Veri silme ile ilgili

[ankidod]

Arkadaşlar merhaba. Akşam üzeri bir konu açmıştım ve Murat OSMA hocam cevaplamıştı sağolsun. Tekrar aynı konu üzerinden mi gitmeliyim yoksa yeni konu mu açmalıyım bilemedim. Neyse uzattım. Soruma geleyim. Elimde aşağıdaki gibi bir kod var. Ben bu kod için bir iki ufak yardım rica edeceğim.

1- Kod çalıştıktan sonra başarılı bir şekilde bulup verileri aktarınca tamam. Ama Bir veri bulamayınca "Veri Bulunamamıştır" mesaj kutusunu çıkaramadım.

2- Bu komut ile çalıştırıp yazdırdığım verileri aynı şekilde silebilecek bir kod nasıl olur acaba?

3- Son olarak bir de iş bitince açılan userformun otomatik kapanması için ne yapmalıyım?

Şimdiden teşekkürler, hürmetler.

Private Sub ComboBox1_Change()

End Sub

Private Sub CommandButton1_Click()
Dim s1 As Worksheet, s2 As Worksheet, sat As Long, sat2 As Long
Dim hcr As Range
If ComboBox1.Value = "" Then Exit Sub
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
sat = s1.Cells(65536, "C").End(xlUp).Row
If [r16] = "" Then
sat2 = 16
Else
sat2 = [r65536].End(3).Row + 1
End If

If WorksheetFunction.CountIf(s1.Range("C:C"), ComboBox1) = 0 Then
MsgBox "Veri Bulunamamıştır", vbCritical
Exit Sub
End If

    For Each hcr In s1.Range("C2:J" & sat)
        If hcr.Value = CDate(ComboBox1.Value) Then
            s2.Range("Q" & sat2) = sat2 - 15
            s2.Range("R" & sat2 & ":AB" & sat2).Value = s1.Range("C" & hcr.Row & ":M" & hcr.Row).Value
            sat2 = sat2 + 1
       Else
    
       End If
    Next
MsgBox ("Verileriniz başarılı bir biçimde aktarılmıştır.")
Unload Me
End Sub


Private Sub CommandButton2_Click()

sonsatır = [Q65536].End(3).Row
Range("Q16:AB" & sonsatır).ClearContents
MsgBox " Temizlendi "
Unload Me

End Sub

Private Sub UserForm_Initialize()
Set s1 = Sheets("Sayfa1")
For a = 1 To s1.[C65535].End(3).Row
V = 0
mah = Trim(s1.Cells(a, "C"))
For b = 0 To ComboBox1.ListCount - 1
If ComboBox1.List(b) = mah Then
V = 1
GoTo atla
End If
Next


atla:
If V <> 1 Then
ComboBox1.AddItem mah
End If
V = 0
Next
End Sub

 

[ankidod]

Umarım bir fırsatı olup ilgilenen arkadaşlarım çıkar. Konuyu güncel tutmak istedim.

 

[Emir Hüseyin Çoban]

. . .

Örnek dosya eklerseniz daha hızlı ve net cevaplar alabilirsiniz.

Tıkla ~ Örnek Dosya Hazırlarken Dikkat Edilmesi Gerekenler

. . .

 

[ankidod]

Haklısınız. Örnek dosya ektedir. Umarım faydalı olur.

 

[Emir Hüseyin Çoban]

. . .

1 nolu mesajınızdaki kodlar, eklediğiniz dosyada farklı. :dusun:

. . .

 

[ankidod]

Sürekli değiştirip bir şeyler deneyip durduğum için sanırım öyle oldu. 1 nolu mesajda ki kodları düzenleyip eki de 1 nolu mesaja ekledim.

 

[Emir Hüseyin Çoban]

. . .

1- Kod çalıştıktan sonra başarılı bir şekilde bulup verileri aktarınca tamam. Ama Bir veri bulamayınca "Veri Bulunamamıştır" mesaj kutusunu çıkaramadım.
3- Son olarak bir de iş bitince açılan userformun otomatik kapanması için ne yapmalıyım?

1 ve 3 için aşağıdaki kodlarını deneyiniz.

Private Sub CommandButton1_Click()
Dim s1 As Worksheet, s2 As Worksheet, sat As Long, sat2 As Long
Dim hcr As Range
If ComboBox1.Value = "" Then Exit Sub
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
sat = s1.Cells(65536, "C").End(xlUp).Row
If [r16] = "" Then
sat2 = 16
Else
sat2 = [r65536].End(3).Row + 1
End If

[B]If WorksheetFunction.CountIf(s1.Range("C:C"), ComboBox1) = 0 Then
MsgBox "Veri Bulunamamıştır", vbCritical
Exit Sub
End If[/B]

    For Each hcr In s1.Range("C2:J" & sat)
        If hcr.Value = CDate(ComboBox1.Value) Then
            s2.Range("Q" & sat2) = sat2 - 15
            s2.Range("R" & sat2 & ":AB" & sat2).Value = s1.Range("C" & hcr.Row & ":M" & hcr.Row).Value
            sat2 = sat2 + 1
       Else
    
       End If
    Next
MsgBox ("Verileriniz başarılı bir biçimde aktarılmıştır.")
[B]Unload Me[/B]
End Sub

2- Bu komut ile çalıştırıp yazdırdığım verileri aynı şekilde silebilecek bir kod nasıl olur acaba?

2 için
Temizlenecek hücre aralığı Q16:AB mi ?

 

[ankidod]

Evet üstad. Yazdırdığımız Q - AB arasındaki veriler için. Yani Q16;AB16, Q17;Ab17... gibi. Kaç satır yazılı ise orada. Bu arada Hocam ellerinize sağlık. Harika olmuş. 1. ve 3. madde için. Çok sağolun.

 

[Emir Hüseyin Çoban]

. . .

Temizle butonu için kodlar:

Private Sub CommandButton2_Click()

sonsatır = [Q65536].End(3).Row
Range("Q16:AB" & sonsatır).ClearContents
MsgBox " Temizlendi "
Unload Me

End Sub

. . .

 

[ankidod]

Hocam harika oldu. Son olarak bütün kodları birleştirip en baştaki mesaja da ekleyeceğim. Bir arkadaşın belki işine yarar. Yalnız bir tek fıstiki yeşilimiz kaldı her boyayı boyadıktan sonra. Temizle kodunu ekledikten sonra listelede ki msgboxlar çıkmıyor. Bunu halledebilir miyiz?

 

[Emir Hüseyin Çoban]

Hocam harika oldu. Son olarak bütün kodları birleştirip en baştaki mesaja da ekleyeceğim. Bir arkadaşın belki işine yarar. Yalnız bir tek fıstiki yeşilimiz kaldı her boyayı boyadıktan sonra. Temizle kodunu ekledikten sonra listelede ki msgboxlar çıkmıyor. Bunu halledebilir miyiz?

. . .

Anlamadım :dusun:
Tablonun bahsettiğiniz halini ekleyiniz.

. . .

 

[ankidod]

Anlamamanız normal hocam çünkü ben hata yapmışım. Ellerinize kollarınıza sağlık. Dört dörtlük çalışıyor istediğim metod. En baştaki mesaja kodları ve çalışır haliyle dosyayı tekrar ekledim. Çok teşekkürler. Gününüz güzel olsun.