Macro ile Rapor satırlarını düzenlemek

[melchiah1978]

Merhaba,

Herkese kolay gelsin, aldığım hazır raporu makro kullanarak hızlıca istediğim forma getirmek istiyorum ama yazılım dili bilmediğimde yardımlarınızı rica edeceğim.
Umarım aşağıdaki yeterince sıkıntımı anlatabilmiş olacağım.

Elinize sağlık şimdiden, selamlar...
___________________________________________________________________________________________________________________________________________________________

Raporu çektiğimde aşağıdaki adımları uygulatacağım;

1) I sutununda "P" ile başlamayan değerli hücrenin satırını komple silmek satır boş ise komple silmek. (örnek I8 "P" ile başlamıyorsa 8. satırı sil, I9 değer içermiyorsa 9.satırı sil)

2) S sütununda "0" a eşit olan tüm satırları sil. (s7=0 ise 7.satır silinmeli)

3) L sütununda "D" ve "Y" değeri olan satırlar kalacak, kalan tüm satırlar silinecek.

 

[DoğanD]

Merhaba,

Aşağıdaki kodu bir butona bağlayarak dener misiniz?

Sub dd()
Dim i, ss As Integer
ss = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To ss
If Left(Cells(i, 16), 1) <> "P" Or Cells(i, 19) = 0 Or Cells(i, 12) <> "D" And Cells(i, 12) <> "Y" Then
Rows(i).Delete
i = i - 1
ss = ss - 1
If ss <> Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub
End If
Next i
End Sub

 

[Muzaffer Ali]

Merhaba.
Alternatif

Sub Test()
    Dim Bak As Long
    Dim Say As Long

    Say = Cells(Rows.Count, "I").End(xlUp).Row
    For Bak = Say To 2 Step -1
        If Cells(Bak, "I") = "" Or UCase(Left(Cells(Bak, "I"), 1)) = "P" Or Cells(Bak, "S") = 0 Or UCase(Cells(Bak, "L")) <> "D" Or UCase(Cells(Bak, "L")) <> "Y" Then
            Rows(Bak).Delete
        End If
    Next
End Sub

 

[melchiah1978]

h

Merhaba.
Alternatif

Sub Test()
    Dim Bak As Long
    Dim Say As Long

    Say = Cells(Rows.Count, "I").End(xlUp).Row
    For Bak = Say To 2 Step -1
        If Cells(Bak, "I") = "" Or UCase(Left(Cells(Bak, "I"), 1)) = "P" Or Cells(Bak, "S") = 0 Or UCase(Cells(Bak, "L")) <> "D" Or UCase(Cells(Bak, "L")) <> "Y" Then
            Rows(Bak).Delete
        End If
    Next
End Sub

Hocam eline sağlık, sanırım blokları birbirine yığıyor ve sonucu yanlış veriyor.
Daha basite indirgesek mesela;

1) A sutununda "P" ile başlamayan hücreye ait satırı silmek, keza satır boş ise de komple silmek.
2) B sütununda "D" ve "Y" değeri olan satırlar kalacak, kalan tüm satırlar silinecek, boş satırlar da dahil.
3) C sütununda "0" a eşit olan tüm satırları sil. Boş satırlar da dahil.

Bu 3 kıstası aynı anda sağlaması gerekiyor. Belki de sıralamadan hata verdi.

Elinize emeğinize sağlık şimdiden teşekkürler.

 

[Muzaffer Ali]

Örnek dosya ekleyiniz.
Bir paylaşım sitesine ekleyebilirsiniz.

 

[melchiah1978]

Örnek dosya ekleyiniz.
Bir paylaşım sitesine ekleyebilirsiniz.

Hızlı dönüşünüz için çok teşekkür ederim.

https://docs.google.com/spreadsheets/d/1OQgxWkN6KiUIxnDyL1y8bQye1ZjcetQO/edit?usp=drive_link&ouid=117876171477190457314&rtpof=true&sd=true

Hocam aşağıda sekmelerde rapor olarak aldığım hali ve macro ile yapılmasını istediğim hali diye sekmeler açtım.

Bilginize,

 

[veyselemre]

Sub test()
    Dim lRow
    Application.ScreenUpdating = False
    Sheets("HAM DATA").Copy After:=Sheets(1)
    Rows("1:4").Delete
    Range("M:R,J:K,A:H").Delete

    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    With Range("A1:D" & lRow)
        .AutoFilter Field:=1, Criteria1:="<>P*"
        Rows("2:" & Rows.Count).Delete
        .AutoFilter
        .AutoFilter Field:=2, Criteria1:="<>D", Operator:=xlAnd, Criteria2:="<>Y"
        Rows("2:" & Rows.Count).Delete
        .AutoFilter
        .AutoFilter Field:=3, Criteria1:="=0"
        Rows("2:" & Rows.Count).Delete
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

 

[melchiah1978]

Sub test()
    Dim lRow
    Application.ScreenUpdating = False
    Sheets("HAM DATA").Copy After:=Sheets(1)
    Rows("1:4").Delete
    Range("M:R,J:K,A:H").Delete

    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    With Range("A1:D" & lRow)
        .AutoFilter Field:=1, Criteria1:="<>P*"
        Rows("2:" & Rows.Count).Delete
        .AutoFilter
        .AutoFilter Field:=2, Criteria1:="<>D", Operator:=xlAnd, Criteria2:="<>Y"
        Rows("2:" & Rows.Count).Delete
        .AutoFilter
        .AutoFilter Field:=3, Criteria1:="=0"
        Rows("2:" & Rows.Count).Delete
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

Elinize emeğinize sağlık hocam.