Makro ile Formülü seçilen hücre aralığına uygulamak

[miha]

Arkadaşlar Merhaba,
Aşağıdaki formülü (I2:I300) hücre aralığına uygulamak istiyorum. Aşağıda yer alan formüldeki "A2" hücresi ise (mutlak olarak belirtilenler hariç) bulunduğu satıra göre değişerek sırasıyla (A3,A4,A5....) gibi olması gerekiyor. Formülün sonucuna göre de "ERROR" sonucu çıkan satırların ise silinmesini istiyorum. Yardımcı olabilecek olan var mı? Şimdiden çok teşekkür ederim.
Formül:
=IF(A2="";"";IF(COUNTIF('Sheet1'!$A$2:$A$300;A2)=0;"ERROR";""))

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kod ile formüle gerek kalmadan istediğiniz yapılabilir.

Sub Test()
    Dim Say As Integer
    Dim Bak As Integer
    Say = Cells(Rows.Count, "A").End(xlUp).Row
    For Bak = Say To 2 Step -1
        If Worksheets("Sheet1").Range("A2:A300").Find(What:=Cells(Bak, "A"), LookIn:=xlValues, MatchCase:=True) Is Nothing Then
            Rows(Bak).Delete
        End If
    Next
End Sub

 

[miha]

Merhaba.

Aşağıdaki kod ile formüle gerek kalmadan istediğiniz yapılabilir.

Sub Test()
    Dim Say As Integer
    Dim Bak As Integer
    Say = Cells(Rows.Count, "A").End(xlUp).Row
    For Bak = Say To 2 Step -1
        If Worksheets("Sheet1").Range("A2:A300").Find(What:=Cells(Bak, "A"), LookIn:=xlValues, MatchCase:=True) Is Nothing Then
            Rows(Bak).Delete
        End If
    Next
End Sub

Geri dönüşünüz için çok teşekkür ederim. Ancak Sheet2 de makroyu çalıştırdığımda; Sheet2'deki "A43" hücresinde yer alan değer Sheet1'deki ($A$2:$A$300) sütununda yer almamasına rağmen Sheet2^'deki 43. Satırı silmedi. Yani Sheet2' sayfasının (A2:A300) arasındaki herhangi bir değer Sheet1 sayfasındaki (A2:A300) aralığında yok ise eğer o halde Sheet2 sayfasındaki o satır silinmeli. Teşekkürler ilginiz için. Nasıl revize edilmeli bilmiyorum.

 

[Muzaffer Ali]

Örnek dosyanızı ekler misiniz?

 

[miha]

Örnek dosyanızı ekler misiniz?

Ekledim, Sayın @dalgalikur
Link bağlatısı aşağıda

İndir Satır Silme Örnek Dosya

Dosyayı indir Satır Silme Örnek Dosya

dosya.co

 

[Muzaffer Ali]

Şimdi oldu.

Sub Test()
    Dim Say As Integer
    Dim Bak As Integer
    Say = Cells(Rows.Count, "A").End(xlUp).Row
    For Bak = Say To 2 Step -1
        If Worksheets("Sheet1").Range("A2:A300").Find(What:=Cells(Bak, "A"), LookIn:=xlValues, MatchCase:=True, LookAt:=xlWhole) Is Nothing Then
            Rows(Bak).Delete
        End If
    Next
End Sub

 

[miha]

Şimdi oldu.

Sub Test()
    Dim Say As Integer
    Dim Bak As Integer
    Say = Cells(Rows.Count, "A").End(xlUp).Row
    For Bak = Say To 2 Step -1
        If Worksheets("Sheet1").Range("A2:A300").Find(What:=Cells(Bak, "A"), LookIn:=xlValues, MatchCase:=True, LookAt:=xlWhole) Is Nothing Then
            Rows(Bak).Delete
        End If
    Next
End Sub

e

Şimdi oldu.

Sub Test()
    Dim Say As Integer
    Dim Bak As Integer
    Say = Cells(Rows.Count, "A").End(xlUp).Row
    For Bak = Say To 2 Step -1
        If Worksheets("Sheet1").Range("A2:A300").Find(What:=Cells(Bak, "A"), LookIn:=xlValues, MatchCase:=True, LookAt:=xlWhole) Is Nothing Then
            Rows(Bak).Delete
        End If
    Next
End Sub

Sayın @dalgalikur ,
Emekleriniz için çok teşekkür ederim. Evet başarıyla çalıştı. Sanırım makro satırında yaptığınız küçük bir değişiklik "LookAt:=xlWhole" şeklinde hatayı düzeltti. Minettarım. Tekrar teşekkürler.

 

[Muzaffer Ali]

Evet tam hücre eşleşmesi ile araması için değişiklik yaptım önceki hali ile 1.1.2019 tarihini arayınca 11.1.2019 tarihini bulup var kabul ediyordu.

Rica ederim. İyi çalışmalar.

 

[miha]

Evet tam hücre eşleşmesi ile araması için değişiklik yaptım önceki hali ile 1.1.2019 tarihini arayınca 11.1.2019 tarihini bulup var kabul ediyordu.

Rica ederim. İyi çalışmalar.

Sayın @dalgalikur iyi geceler,
Yeni farkettiğim birşey oldu. Örneğin ben o anda hangi sayfada bu makroyu çalıştırıyorsam o sayfaya uygulanıyor makro. Ancak örneğin Makro için Sheet3 sayfasına bir kısayol butonu oluşturdum ve makroyu ordan çalıştırıyorum. E haliyle makroyu çalıştırdığım sayfa Sheet3 olunca Sheet2'deki satırları değil de Sheet3 deki satırları siliyor. Bunu engellemek için koda nasıl bir ekleme yapmak gerekir. Yani Makroyu hangi sayfada çalıştırırsam çalıştırayım işlemin sonucunda Sheet2 deki satırları silmeli. Tekrar teşekkürler.

 

[Korhan Ayhan]

Deneyiniz.

Sub Test()
    Dim Say As Integer
    Dim Bak As Integer
    With Worksheets("Sheet2")
    Say =.Cells(.Rows.Count, "A").End(xlUp).Row
    For Bak = Say To 2 Step -1
        If Worksheets("Sheet1").Range("A2:A300").Find(What:=.Cells(Bak, "A"), LookIn:=xlValues, MatchCase:=True, LookAt:=xlWhole) Is Nothing Then
            .Rows(Bak).Delete
        End If
    Next
    End With
End Sub

 

[miha]

Deneyiniz.

Sub Test()
    Dim Say As Integer
    Dim Bak As Integer
    With Worksheets("Sheet2")
    Say =.Cells(.Rows.Count, "A").End(xlUp).Row
    For Bak = Say To 2 Step -1
        If Worksheets("Sheet1").Range("A2:A300").Find(What:=.Cells(Bak, "A"), LookIn:=xlValues, MatchCase:=True, LookAt:=xlWhole) Is Nothing Then
            .Rows(Bak).Delete
        End If
    Next
    End With
End Sub

Sayın @Korhan Ayhan
İlginiz için teşekkür ederim. Dediğiniz gibi revize ettim. Başka bir sayfada makroya "Run" dedim. Ancak yine makroyu çalıştırdığım aktif sayfadaki
satırları sildi. Ben ise kodda belirttiğiniz şekilde makroyu hangi sayfada çalıştırırsam çalıştırayım yalnızca "Sheet2" deki satırlara
bu silme işlemini gerçekleştirmesini istiyorum. Ne yapmam gerekir bilmiyorum. Saygılarımla,

 

[Muzaffer Ali]

Aşağıdaki kodlar ile Sayfa2 den başka hiçbir sayfadan satır silinemez.

Muhtemelen siz bir yerde hata yapıyorsunuz.
Kodların en alt satırdan başlayarak sildiğini belirteyim.

Yinede olmazsa dosyanız ekleyin kontrol edelim.

Sub Test()
    Dim Say As Integer
    Dim Bak As Integer
    With Worksheets("Sheet2")
        Say = .Cells(.Rows.Count, "A").End(xlUp).Row
        For Bak = Say To 2 Step -1
            If Worksheets("Sheet1").Range("A2:A300").Find(What:=.Cells(Bak, "A"), LookIn:=xlValues, MatchCase:=True, LookAt:=xlWhole) Is Nothing Then
                .Rows(Bak).Delete
            End If
        Next
    End With
End Sub

 

[miha]

Aşağıdaki kodlar ile Sayfa2 den başka hiçbir sayfadan satır silinemez.

Muhtemelen siz bir yerde hata yapıyorsunuz.
Kodların en alt satırdan başlayarak sildiğini belirteyim.

Yinede olmazsa dosyanız ekleyin kontrol edelim.

Sub Test()
    Dim Say As Integer
    Dim Bak As Integer
    With Worksheets("Sheet2")
        Say = .Cells(.Rows.Count, "A").End(xlUp).Row
        For Bak = Say To 2 Step -1
            If Worksheets("Sheet1").Range("A2:A300").Find(What:=.Cells(Bak, "A"), LookIn:=xlValues, MatchCase:=True, LookAt:=xlWhole) Is Nothing Then
                .Rows(Bak).Delete
            End If
        Next
    End With
End Sub

Sayın @dalgalikur ve @Korhan Ayhan ,
İstediğim gibi çalıştı. Peki nerede hata yapmışım? Ben ilk göze çarpan "With Worksheets("Sheet2") " satırı nedeniyle önceki koda bunu eklemiştim. Daha sonra detaylıca baktığımda farklı olarak "Matchcase=True" şeklinde bir ekleme yapıldığını şimdi farkettim. Bir de Sayın Korhan Ayhan'ın gönderdiği kodda "End İf" "End With" satır paragraf boşlukları alt alta iken sizin paylaştığınız şekilde satır paragraf girdi boşluklarını da sizin gönderdiğiniz şekilde revize ettim sayın @dalgalikur . Her ikinize de emekleriniz için çok çok teşekkür ederim. Sağolun.

 

[Muzaffer Ali]

Sayın Korhan Ayhan'ın eklediği kodlara hiçbir ilave yapmadım aynen kopyalayıp yapıştırdım. Satır başlarındaki boşlukların hiçbir önemi yok sadece kodları okumayı kolaylaştırmak işine yarar.

Sorunun çözülmesine sevindim. Kolay gelsin.