bir shette olan verileri diğer sheetlerde bulup silmek

[u.L.a.s]

Merhaba

diyelimki sheet1 de alt alta her hücrede veri olsun . ben butona bastığımda her hücredeki veriyi diğer sheetlerde arayıp var ise o shette aynı olan veriyi silsin.

Örneğin

Sheet1
A1 = 8888
A2 = 7777
A3 = a2359
A4 = 65ggg
.
.
.

Şeklinde giden veriler olsun.

ben makroyu çalıştırdığımda önce a1 verisini diğer sheetlerde bulsun diyelimki sheet5 te G8 de 8888 verisi var. bunu bulunca G8 den bu veriyi silsin
sonra a2 ye baksın. 7777 verisi hiç bir sheette yoksa bir alta geçsin A3 teki veriyi arasın a2359 verisini sheet8 de D55 te bulsun ve silsin hatta sheet11 de M11 dede bu veri olsun ve onuda silsin. gibi...

en son makro bitince msgbox ile tamamlandı uyarısı ile sonlandırabiliriz.

Bilgi ve yardımlarınızı rica ederim

 

[turist]

Sayın @u.L.a.s ,
Hem eski hem de deneyimli bir üyemizsiniz.
Tavsiyem:Lütfen "örnek" excel dosyanızı Forum'a iletin ki; cevap vermek isteyenlere de yardım olsun, siz de hızlı ve doğru sonuca daha kolay ulaşın.
Eğer, örnek dosya ekleme hakkında da bilgi edinmek isterseniz;
https://www.excel.web.tr/threads/soru-ile-ilgili-oernek-excel-dosyasi-ekleme.174755/
bakınız.

 

[u.L.a.s]

merhaba üstadım. aslında basit bir soru olduğundan örnek dosyaya gerek duymamıştım. o yüzden yüklemedim.

örnek dosya aşağıdaki linktedir.

örnek dosyada olması gereken makroyu anlatayım kısaca.
sayfa1 de örneğin sas verisinden başlayarak diğer sheetlerde var mı yokmu bakacak hangi sheette bu veri varsa silecek. baktığımız zaman sayfa4 te var sadece.

sonra bir sonraki veriye geçecek. dasd verisini diğer sheetlerde arayaca bu veri sayfa2 de 2 tane ayrı hücrelerde var ve sayfa4 te bir tane hücrede var. bulup silecek.

bir sonraki veri asdasd diğer sheetlerde arayacak. sayfa2 de 2 tane sayfa3 te 1 tane sayfa4 te 1 tane bulunuyor. onları silecek

bir sonraki ver xxx diğer sheetlerde arayacak. diğer sheetlerde bir tane bile yok bu veriyle alakalı silme işlemi yapmadan bir sonraki veriye geçecek. a sütunundaki en son veriye kadar bu tarama bulma ve silme işlemini yaparak bitirecek.

http://s7.dosya.tc/server10/pd2rf3/ornek_-_Kopya.xlsx.html

Teşekkürler

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Sayfalarda_Bul_Sil()
    Dim S1 As Worksheet, Sayfa As Worksheet
    Dim Son As Long, X As Long, Bul As Range
    Dim Say As Long, Adres As String, Alan As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set S1 = Sheets("Sayfa1")
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    
    For X = 2 To Son
        If S1.Cells(X, 1) <> "" Then
            For Each Sayfa In ThisWorkbook.Worksheets
                If Sayfa.Name <> S1.Name Then
                    Set Bul = Sayfa.Cells.Find(S1.Cells(X, 1), , , xlWhole)
                    If Not Bul Is Nothing Then
                        Adres = Bul.Address
                        Do
                            Say = Say + 1
                            If Alan Is Nothing Then
                                Set Alan = Bul
                            Else
                                Set Alan = Union(Alan, Bul)
                            End If
                            Set Bul = Sayfa.Cells.FindNext(Bul)
                        Loop While Not Bul Is Nothing And Bul.Address <> Adres
                    End If
                End If
                If Not Alan Is Nothing Then
                    Alan.Delete xlUp
                    Set Alan = Nothing
                End If
            Next
        End If
    Next
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    If Say > 0 Then
        MsgBox Say & " adet veri bulunmuştur." & Chr(10) & Chr(10) & _
               "Bulunan veriler sayfalardan silinmiştir.", vbExclamation
    Else
        MsgBox "Veri bulunamadı!", vbInformation
    End If
End Sub

 

[u.L.a.s]

Üstadım emeğine bilgine sağlık hayranım şunları yazıyorsunuz. bende bunu yapmak istiyorum ama en ufak soruda bile ne yazacağımı nasıl yazacağımı bilemiyorum. öyle durumdada size başvuruyorum. inanın emeklerinizin hakkını ödeyemem.