Soru Farklı Sayfadaki Bir Satırı Diğer Sayfaya Göre Silme

[dengeceteris]

Sevgili Uzman Arkadaşlar aşağıda yazdığım konuda yardımlarınız için tşk ederim.

2 Sayfam var. (Sayfa1 ve Sayfa2) Her iki sayfam da A arası sütunlarda veriler var ve her iki sayfada A sütunlarında benzersiz ID numraları var. Yapmak istediğim ise Sayfa1 de bir satırı (hücre içini değil) silersem Sayfa2 deki aynı ID numaraya sahip satırıda komple silmek mümkün mü ? Örneler mevcut ama ben uyarlayamadım.
Saygılarımla

 

[volki_112]

@dengeceteris istediğin işlemi yapacak kod

Private Sub Worksheet_BeforeDelete(ByVal Target As Range, Cancel As Boolean)
    Dim sayfa1 As Worksheet
    Dim sayfa2 As Worksheet
    Dim id As String
    Dim satirSayfa2 As Range
    Dim bulunanSatir As Range
    
    ' Sayfa1 ve Sayfa2'yi tanımla
    Set sayfa1 = ThisWorkbook.Sheets("Sayfa1")
    Set sayfa2 = ThisWorkbook.Sheets("Sayfa2")
    
    ' Silinen satırdaki A sütunundaki ID'yi al
    id = Target.Cells(1, 1).Value
    
    ' Sayfa2'deki A sütununda bu ID'yi ara
    Set bulunanSatir = sayfa2.Columns("A").Find(id, LookIn:=xlValues)
    
    ' Eğer bulursa, Sayfa2'deki satırı sil
    If Not bulunanSatir Is Nothing Then
        bulunanSatir.EntireRow.Delete
    End If
End Sub

 

[dengeceteris]

SEvgili Üstadım.. ben bu kodu modül açtım yapıştırdım, sayfalara veya ana sayfaya her yere koydum ama bir satırı silince bir işlem yapmadı. Bu tepkimeyi nasıl harekete geçirmem gerekiyor.

 

[volki_112]

Hocam chatgpt.com a kodunu yapıştırıp hata veren satirlari belirt sana dogru kodu verecektir. Yanlis kod verirse dönüt vere vere dogruya ulasirsin.

 

[dengeceteris]

Hiç bir tepki vermediği için ordan da bir hata göstermedi. Olmadı yani sonuçta

 

[dengeceteris]

Yardımcı olan birisi olursa mutlu olurum

 

[dengeceteris]

Cevap yazan çıkmadığı için konuyu kapatıyorum mecburen teşekkürler yinede…

 

[Biolightant]

Merhaba,
Sayfada bir Satır silindiğinde(Delete) direk tetiklenen bir olay yok maalesef
Worksheet_Change olayından yararlanarak kodları yazdım
Sayfa1 ismini fare ile sağ tıklayıp - Kod Görüntüle tıklayıp kodları açılan pencereye ekleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim DeleteAddress As String
    Dim StartRow As Long
    Dim EndRow As Long
    Dim IsEmptyRow As Boolean
    Dim Cell As Range
    Dim OldValue As Variant

    ' $ işaretlerini kaldırarak adresi al
    DeleteAddress = Target.Address(False, False)
    
    ' Eğer adres "5:5"
    If InStr(DeleteAddress, ":") > 0 Then
        ' Satır aralığını belirle
        StartRow = Target.Row
        EndRow = Target.Rows(Target.Rows.Count).Row
        
        ' Eklenen veya değiştirilen satır(lar) boş mu kontrol et
        IsEmptyRow = True
        For Each Cell In Target
            If Not IsEmpty(Cell.Value) Then
                IsEmptyRow = False
                Exit For
            End If
        Next Cell
        
        If IsEmptyRow Then Exit Sub
        
        If StartRow = EndRow Then
          
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
        
        OldValue = Me.Range("A" & Target.Row - 1).Value
        
        Application.EnableEvents = False
        Me.Range("A" & Target.Row - 1).EntireRow.Delete
        Application.EnableEvents = True
        
        
        If OldValue = "" Then Exit Sub
        
        ' Sayfa2'deki A sütununda OldValue bul
        Set bulunanSatir = ThisWorkbook.Sheets("Sayfa2").Columns("A").Find(OldValue, LookIn:=xlValues)
        
        ' Eğer bulursa, Sayfa2'deki satırı sil
        If Not bulunanSatir Is Nothing Then bulunanSatir.EntireRow.Delete
        End If
      
    End If

End Sub

 

[dengeceteris]

Sevgili Biolightant ilginiz için tşk ediyorum ancak kod herhangi bir tepki vermedi. Eklediğim dosyada birinci aşamada eşleşme ve renklendirme yapıyorum. Ama diğerini halledemedim.

 

[Biolightant]

Test için oluşturduğum SatirSil.xlsm Dosyasında test etmiştim çalışıyordu ama...

Dosyayı harici bir linkte paylaşırmısınız.

 

[dengeceteris]

ÖRNEK.xlsm - Shared with pCloud

Keep all your documents safe, access them on any device you own and share with just the right people. Create a free pCloud account!

u.pcloud.link

 

[Biolightant]

Kodları Sadece Sayfa1 içine yazılacak Sayfa2 ye yazılmayacak

SARI renge boyadıklarınız(her iki sayfada bulunanlar) dan herhangi bir satırı silerseniz çalıştığını göreceksiniz.

ÖRNEK.xlsm Dosyanızın düzenlenmiş şekli

 

[dengeceteris]

Sayın Biolightant elinize sağlık bir husus hariç çalıştı. O da Sayfa 1 de en alttaki satırı silersem yada öyle denk geldi mesela en son satırı sildim diğer sayfayı silmiyor. Ama bir üst satırdan silersem siliyor. Birde diyelim ki iki satır alt alta ikisini seçip silersem silmiyor zannedersem her defasında tek satıra izn veriyor.

 

[Biolightant]

her defasında tek satıra izn veriyor.

evet kod tek bir satır silinirse çalışıyor o şekilde kodladım.

Evet en son veri silerseniz çalışmıyor yeniden kurgulamak lazım. (bir ihtimal IsEmptyRow kaynaklı)

Esasında Projenizde hangi satırın silindiğini bulmak yerine
Kullanıcıya silmek istediği satırı(Müsteriyi) sorun veya seçtirin
sonra Sayfa1 ve Sayfa2 de onları bulup silin.

ama benden bu kadar kolay gelsin.

 

[dengeceteris]

evet kod tek bir satır silinirse çalışıyor o şekilde kodladım.

Evet en son veri silerseniz çalışmıyor yeniden kurgulamak lazım. (bir ihtimal IsEmptyRow kaynaklı)

Esasında Projenizde hangi satırın silindiğini bulmak yerine
Kullanıcıya silmek istediği satırı(Müsteriyi) sorun veya seçtirin
sonra Sayfa1 ve Sayfa2 de onları bulup silin.

ama benden bu kadar kolay gelsin.

Çok tşk ederim hocam.. bu da yeterli benim için

 

[Biolightant]

Kullanıcıya silmek istediği satırı(Müsteriyi) sorun veya seçtirin

InputBox ile kullanıcıya silinecek satırları soran çalışma ÖRNEK01.xlsm Dosyası Linki

ÖRNEK01.xlsm Dosyasındaki kodlar.

Sub SatirSilme()
    Dim seciliAralik As Range
    Dim satir As Range
    Dim arananDeger As String
    Dim bulunanHücre As Range
    Dim onay As VbMsgBoxResult
    Dim isSayfa1 As Boolean
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    
    ' Sayfaları tanımla
    Set ws1 = ThisWorkbook.Sheets("Sayfa1")  ' Sayfa1 ismini uygun şekilde değiştirin
    Set ws2 = ThisWorkbook.Sheets("Sayfa2")  ' Sayfa2 ismini uygun şekilde değiştirin
    
    ' Sayfa1'i seç
    ws1.Select
    
    ' Kullanıcıdan silmek istediği satırları seçmesini iste
    On Error Resume Next
    Set seciliAralik = Application.InputBox("Silmek istediğiniz satırları " & ws1.Name & "'de seçin:", Type:=8)
    On Error GoTo 0
    
    ' Kullanıcı seçim yapmazsa çık
    If seciliAralik Is Nothing Then
        MsgBox "İşlem iptal edildi.", vbExclamation, "Seçim yapılmadı."
        Exit Sub
    End If
    
    ' Seçimin sadece Sayfa1'de olup olmadığını kontrol et
    isSayfa1 = True
    For Each satir In seciliAralik
        If satir.Worksheet.Name <> ws1.Name Then
            isSayfa1 = False
            Exit For
        End If
    Next satir
    
    If Not isSayfa1 Then
        MsgBox "Seçim sadece " & ws1.Name & "'de yapılmalıdır!", vbExclamation, "Yanlış seçim"
        Exit Sub
    End If
    
    ' Seçilen aralıkta işlem onayı al
    onay = MsgBox("Seçilen satırları silmek istiyor musunuz?", vbYesNo + vbQuestion, "Onay")
    If onay = vbNo Then Exit Sub
    
    Application.ScreenUpdating = False ' Ekran güncellemelerini kapat
    
    ' Sayfa2'deki eşleşen değerleri sil
    With ws2
        For Each satir In seciliAralik.Rows
            arananDeger = Trim(satir.Cells(1, "A").Value)
            If arananDeger <> "" Then
                Do
                    Set bulunanHücre = .Columns("A").Find(What:=arananDeger, LookIn:=xlValues, LookAt:=xlWhole)
                    If Not bulunanHücre Is Nothing Then
                        bulunanHücre.EntireRow.Delete ' Eşleşen satırı sil
                    Else
                        Exit Do
                    End If
                Loop
            End If
        Next satir
    End With
    
    ' Sayfa1'deki seçilen satırları sil
    seciliAralik.EntireRow.Delete
    
    Application.ScreenUpdating = True ' Ekran güncellemelerini aç
    MsgBox "İşlem tamamlandı.", vbInformation
End Sub