Soru İki Koşul Arasındaki Değerleri Alma

[aLp59]

Arkadaşlar Merhaba,

İki koşul arasındaki değerleri yazdırmak istediğim bir tablom var, ekte anlatmaya çalıştım.

Teşekkür ederim.

 

[Ziynettin]

Sub kod()
Dim a(), b(), y1, y2, i As Long, say As Long

a = Range("A1").CurrentRegion.Value

ReDim b(1 To UBound(a), 1 To 2)

For i = 1 To UBound(a)
    If a(i, 4) = "-" Then a(i, 4) = ""
    If a(i, 4) <> "" Then y1 = a(i, 4)
    If a(i, 2) <> 0 Then y2 = a(i, 2)
    a(i, 4) = y1
    a(i, 2) = y2
    If a(i, 2) > 0 And a(i, 4) = "P" Then
        say = say + 1
        b(say, 1) = a(i, 1)
        b(say, 2) = a(i, 3)
    End If
Next i

Range("F1").CurrentRegion.Offset(1).ClearFormats
Range("F1").CurrentRegion.Offset(1).ClearContents

If say > 0 Then
    [F2].Resize(say, 2) = b
    [F2].Resize(say, 2).Borders.Color = rgbSilver
End If

MsgBox "İşlem tamam.", vbInformation
End Sub

 

[aLp59]

Sayın Ziynettin,

Harika oldu.
Çok teşekkür ediyorum