• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Çift Koşullu - Çift Satır Makroyu Uyumlaştırmak

Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Merhaba Arkadaşlar,
Aşağıdaki koddaki 2 koşullu satırları birlikte çalıştıramadım. Acaba kodda nasıl bir değişiklik yapılmalı ?
Ya "Alacak" satırı çalışıyor ya da "Borc" satırı.
Araya Else koyarak denedim ama yine olmadı. Örnek dosya ektedir.

Code:
Sub DURUM()
Dim s1 As Worksheet, s2 As Worksheet, a(), b()
Dim i As Long, say As Long
Set s1 = Sheets("RAPOR")
Set s2 = Sheets("URUN")
aranan = [B1]
a = s2.Range("A3:Z" & s2.Cells(Rows.Count, 1).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 5)
For i = 1 To UBound(a)

'If Range("A1") = "Alacak" And a(i, 6) > (aranan) Then
If Range("A1") = "Borc" And a(i, 6) < (-1 * aranan) Then

say = say + 1
b(say, 1) = a(i, 1)
b(say, 2) = a(i, 2)
b(say, 3) = a(i, 6)

End If
' End If
Next i
s1.Range("A5:E" & Rows.Count).ClearContents
If say > 0 Then
s1.[A5].Resize(say, 5) = b
End If
End Sub
 

Ekli dosyalar

Kod:
Sub DURUM()
    Dim s1 As Worksheet, s2 As Worksheet, a(), b()
    Dim i As Long, say As Long, al As Boolean
    Set s1 = Sheets("RAPOR")
    Set s2 = Sheets("URUN")
    aranan = [B1]
    a = s2.Range("A3:F" & s2.Cells(Rows.Count, 1).End(3).Row).Value
    ReDim b(1 To UBound(a), 1 To 5)
    For i = 1 To UBound(a)

        If Range("A1") = "Alacak" And a(i, 6) >= aranan Then
            al = True
        ElseIf Range("A1") = "Borc" And a(i, 6) <= (-1 * aranan) Then
            al = True
        Else
            al = False
        End If
        If al Then
            say = say + 1
            b(say, 1) = a(i, 1)
            b(say, 2) = a(i, 2)
            b(say, 3) = a(i, 6)
        End If
    Next i
    s1.Range("A5:E" & Rows.Count).ClearContents
    If say > 0 Then
        s1.[A5].Resize(say, 5) = b
    End If
End Sub
 
Kod:
Sub DURUM()
    Dim s1 As Worksheet, s2 As Worksheet, a(), b()
    Dim i As Long, say As Long, al As Boolean
    Set s1 = Sheets("RAPOR")
    Set s2 = Sheets("URUN")
    aranan = [B1]
    a = s2.Range("A3:F" & s2.Cells(Rows.Count, 1).End(3).Row).Value
    ReDim b(1 To UBound(a), 1 To 5)
    For i = 1 To UBound(a)

        If Range("A1") = "Alacak" And a(i, 6) >= aranan Then
            al = True
        ElseIf Range("A1") = "Borc" And a(i, 6) <= (-1 * aranan) Then
            al = True
        Else
            al = False
        End If
        If al Then
            say = say + 1
            b(say, 1) = a(i, 1)
            b(say, 2) = a(i, 2)
            b(say, 3) = a(i, 6)
        End If
    Next i
    s1.Range("A5:E" & Rows.Count).ClearContents
    If say > 0 Then
        s1.[A5].Resize(say, 5) = b
    End If
End Sub
veyselemre üstadım elinize sağlık, çok teşekkür ederim. Sağlıcakla kalın
 
Geri
Üst