İstenilen değerse o Satırı yazdırmak

[5353]

Veri sayfasında D Sütununda " Sigorta gün" yazıyor. E sütünün da karşısındaki değer Eğer "30" dan küçükse o SATIRI yazsın.

 

[YUSUF44]

Aşağıdaki makroyu deneyin:

Sub eksikgun()
Set s1 = Sheets("Veri")
Set s2 = Sheets("Eksik Gün")
son = s1.Cells(Rows.Count, "E").End(3).Row
Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""


sorgu = "select F1,F2,F3,F4,F5,F6 from[Veri$D5:I" & son & "] where " _
        & "F1='Sigorta Gün:' and F2<30"

Set rs = con.Execute(sorgu)
s2.[D2].CopyFromRecordset rs
End Sub

 

[Ömer]

Merhaba,

Deneyiniz.

Sub YuvarlatılmışDikdörtgen1_Tıkla()

    Dim S1 As Worksheet, c As Range, Adr As String, sat As Long
    
    Set S1 = Sheets("Veri")
    
    Application.ScreenUpdating = False
    Sheets("Eksik Gün").Select
    Range("D2:I" & Rows.Count).Clear
    
    sat = 2
    Set c = S1.[D:D].Find("Sigorta Gün:", , xlValues, xlWhole)
    If Not c Is Nothing Then
        Adr = c.Address
        Do
            If S1.Cells(c.Row, "E") < 30 Then
                S1.Cells(c.Row, "D").Resize(1, 6).Copy Cells(sat, "D")
                sat = sat + 1
            End If
            Set c = S1.[D:D].FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Adr
    End If

End Sub

 

[5353]

Teşekkürler ustadlar. Siz olmasaydınız biz ne yapacaktık. elleriniz derst görmesin.