İstenilen Yerden Aşağısını Silme

[hakki83]

Değerli hocalarımız selamlar

Örnek dosyada A ve B sütunlarını, istenilen yerden silecek kodları oluşturabilir misiniz?

Detaylı açıklamayı dosya içine de yazdım.

Teşekkürler.

 

[Korhan Ayhan]

Merhaba,

YARI OLUMLULAR dediğinizde A22:B28 aralığımı silinmeli?

 

[hakki83]

Merhaba,

YARI OLUMLULAR dediğinizde A22:B28 aralığımı silinmeli?

Merhaba,
Sorunuz güzel hocam,

Değil, tamamen aşağısı silinmeli.

İlk olarak Olumlular tek başına her zaman lazım olan bilgi.

Bazen olumlulara ilave olarak yarı olumluları da eklemek gerekebilir. (İkisi birlikte)

Şu an için amaç bu yönde.
Eğer farklı bir ihtiyaç oluşursa, memnuniyetle ilave konu açarak dile getirebilirim.

 

[Korhan Ayhan]

Ben biri için örnek veriyorum. Diğerini kendiniz halledersiniz.

Option Explicit

Private Sub CommandButton2_Click()
    Dim Bul As Range
       
    With Sheets("RAPOR")
        .Select
        Set Bul = .Range("B:B").Find("YARI OLUMLULAR", , , xlWhole)
        If Not Bul Is Nothing Then
            Bul.Resize(.Rows.Count - Bul.Row).EntireRow.Select
        End If
        Set Bul = Nothing
    End With
End Sub

 

[dEdE]

Merhaba,
Sorunuzu böyle anladım. Dener misiniz?

Private Sub CommandButton1_Click() 'Olumsuzlar
    Set ws1 = Sheets("RAPOR")
    ss = ws1.Cells(Rows.Count, "B").End(xlUp).Row
    Application.GoTo Reference:=Range(Range("B:B").Find("OLUMSUZLAR", LookAt:=xlWhole).Address)
    ws1.Range(ws1.Cells(ActiveCell.Row, 1), ws1.Cells(ss, 2)).ClearContents
Set ws1=Nothing
End Sub

Private Sub CommandButton2_Click() 'YarıOlumlular
    Set ws1 = Sheets("RAPOR")
    ss = ws1.Cells(Rows.Count, "B").End(xlUp).Row
    Application.GoTo Reference:=Range(Range("B:B").Find("YARI OLUMLULAR", LookAt:=xlWhole).Address)
    ws1.Range(ws1.Cells(ActiveCell.Row, 1), ws1.Cells(ss, 2)).ClearContents
Set ws1=Nothing
End Sub

Korhan Ayhan Hocam cevaplamış bile. Sayfayı yenilemeden cevap yazmamalı

 

[hakki83]

Dede hocam ve Korhan hocamın kodları hatasızdır. Teşekkür ederim. Emeğinize sağlık.
Farklı hocalarımızdan gelen alternatiflerden çok memnunuz.

 

[hakki83]

Korhan hocam ve Dede hocam merhaba.



Benzer şekilde aynı örnek dosyada şu üç kodu da oluşturabilir miyiz?

Birinci düğmeye basınca A22:B28 alanı, yani YARI OLUMLULAR
kesilip, başlığın altına, ikinci satıra taşınacak, diğer bilgiler silinecek.


İkinci düğmeye basınca A29:B35 alanı, yani OLUMSUZLAR
kesilip, başlığın altına, ikinci satıra taşınacak, diğer bilgiler silinecek.

Üçüncü düğmeye basınca A22:B35 alanı, yani Y. OLUMLULAR + OLUMSUZLAR
kesilip, başlığın altına, ikinci satıra taşınacak, diğer bilgiler silinecek

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Makro1()
    ActiveSheet.Range("A:B").AutoFilter Field:=2, Criteria1:="<>YARI OLUMLULAR"
    On Error Resume Next
    Range("A2:B" & WorksheetFunction.Max(2, Cells(Rows.Count, 1).End(3).Row)).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    ActiveSheet.ShowAllData
    On Error GoTo 0
End Sub

Sub Makro2()
    ActiveSheet.Range("A:B").AutoFilter Field:=2, Criteria1:="<>OLUMSUZLAR"
    On Error Resume Next
    Range("A2:B" & WorksheetFunction.Max(2, Cells(Rows.Count, 1).End(3).Row)).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    ActiveSheet.ShowAllData
    On Error GoTo 0
End Sub

Sub Makro3()
    ActiveSheet.Range("A:B").AutoFilter Field:=2, Criteria1:="<>OLUMSUZLAR", Operator:=xlAnd, Criteria2:="<>YARI OLUMLULAR"
    On Error Resume Next
    Range("A2:B" & WorksheetFunction.Max(2, Cells(Rows.Count, 1).End(3).Row)).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
    ActiveSheet.ShowAllData
    On Error GoTo 0
End Sub

 

[hakki83]

Korhan hocam merhaba olmuştur emeğinize sağlık. Sadece mümkünse hani düğmeye basılınca sonuçlar aktarılırken en üstte filtre okları oluşuyor ya, işte o okların oluşmamasını ya da silinmesini sağlayacak satırı da ekleyebilir miyiz lütfen?

 

[Korhan Ayhan]

ActiveSheet.ShowAllData satırını silip aşağıdaki satırı ekleyiniz.

If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False