Koşullu Alan Seçimi

[baydeniro]

Merhaba Arkadaşlar,
Koşullu alan seçimi mümkün mü ? Adetlerin yazılı olduğu D sütununda sıfırdan büyük olanları kapsayabilir mi ? A710

 

[Necdet]

Merhaba,

Sıfırdan büyük değerler listenin hep altında mı? dosyanızda olduğu gibi, karışıksa nasıl bir çözüm düşünüyorsunuz?

 

[baydeniro]

Merhaba,

Sıfırdan büyük değerler listenin hep altında mı? dosyanızda olduğu gibi, karışıksa nasıl bir çözüm düşünüyorsunuz?

Necdet üstadım teşekkür ederim. Sıfırlar hep yukardıda, Sıfırdsn büyük olanlar hep aşağıda olacak. Sıfırlar ve pozitif sayılar karışık olmayacak.

 

[balanar]

D sutunu 0'dan büyükse A'dan D'ye sarı olarak renklendiren çalışma ektedir


For a = 2 To 120 burayı sonsuz yapmak lazım satır ekleyecekseniz ama onun nasıl oldugunu cıkaramadım açıkcası ustadlar yardım edecektir mutlaka

Kullanılan kodlar aşağıdadır. Profesyonel değilim forumda bilgi edinmek ve yardım talep etmek için dolaşırım genelde.. Olduysa ne mutlu bana, ama üstadlara danışmakta fayda var mutlaka eksiğimiz vardır

Private Sub CommandButton1_Click()
Dim a As Byte
For a = 2 To 120
    If Cells(a, "D") >= "1" Then
        With Range("A" & a & ":D" & a)
            .Interior.ColorIndex = 6
        End With
    Else
    If Cells(a, "D") >= "1" Then
        With Range("A" & a & ":D" & a)
            .Interior.ColorIndex = 6

        End With
    End If
    End If
Next
End Sub

 

[baydeniro]

D sutunu 0'dan büyükse A'dan D'ye sarı olarak renklendiren çalışma ektedir


For a = 2 To 120 burayı sonsuz yapmak lazım satır ekleyecekseniz ama onun nasıl oldugunu cıkaramadım açıkcası ustadlar yardım edecektir mutlaka

Kullanılan kodlar aşağıdadır. Profesyonel değilim forumda bilgi edinmek ve yardım talep etmek için dolaşırım genelde.. Olduysa ne mutlu bana, ama üstadlara danışmakta fayda var mutlaka eksiğimiz vardır

Private Sub CommandButton1_Click()
Dim a As Byte
For a = 2 To 120
    If Cells(a, "D") >= "1" Then
        With Range("A" & a & ":D" & a)
            .Interior.ColorIndex = 6
        End With
    Else
    If Cells(a, "D") >= "1" Then
        With Range("A" & a & ":D" & a)
            .Interior.ColorIndex = 6

        End With
    End If
    End If
Next
End Sub

balanar yardımın için çok teşekkür ederim. Eline sağlık. Bu şekilde harika. Buna bir alternatif olarak ilgili alanı renklendirme yerine SELECT nasıl yapabiliriz !

 

[balanar]

kodda hata var sanırım @Necdet bey yardımcı olur müsait olunca

 

[YUSUF44]

Deneyiniz:

Private Sub CommandButton1_Click()
son = Cells(Rows.Count, "D").End(3).Row
For i = 2 To son
    If Cells(i, "D") > 0 Then
        Range("A" & i & ":D" & son).Select
        Exit Sub
    End If
Next
End Sub

 

[Necdet]

Merhaba,

D sütunu A-Z olarak sıralandığı varsayımıyla, aşağıdaki kodları dener misiniz? İlk aklıma gelen çözümü yazdım.

Sub Sec()

    Dim i   As Long, _
        j   As Long
    
    j = Cells(Rows.Count, "A").End(3).Row
    i = 2
    
    Do While Cells(i, "D") < 1
        i = i + 1
    Loop
    
    Range(Cells(i, "A"), Cells(j, "D")).Select
    
End Sub

 

[Necdet]

Yusuf bey daha kestirmeden gitmiş

 

[Korhan Ayhan]

Alternatif;

Son satır olarak 1000 değerini baz aldım. Sizde veri daha çoksa değiştirip kullanabilirsiniz.

Option Explicit

Sub Test()
    Dim X, Y
    X = Evaluate("MIN(IF(D2:D1000<>0,ROW(D2:D1000)))")
    Y = Evaluate("IFERROR(LOOKUP(2,1/(D2:D1000),ROW(D2:D1000)),0)")
    If X > 0 And Y > 0 Then
        Range("A" & X & ":D" & Y).Select
    Else
        MsgBox "Koşula uygun satır bulunamadı!", vbExclamation
    End If
End Sub

 

[baydeniro]

Deneyiniz:

Private Sub CommandButton1_Click()
son = Cells(Rows.Count, "D").End(3).Row
For i = 2 To son
    If Cells(i, "D") > 0 Then
        Range("A" & i & ":D" & son).Select
        Exit Sub
    End If
Next
End Sub

YUSUF44 üstadım elinize, emeğinize sağlık, harika olmuş. Sağlıcakla kalın

 

[baydeniro]

Merhaba,

D sütunu A-Z olarak sıralandığı varsayımıyla, aşağıdaki kodları dener misiniz? İlk aklıma gelen çözümü yazdım.

Sub Sec()

    Dim i   As Long, _
        j   As Long
   
    j = Cells(Rows.Count, "A").End(3).Row
    i = 2
   
    Do While Cells(i, "D") < 1
        i = i + 1
    Loop
   
    Range(Cells(i, "A"), Cells(j, "D")).Select
   
End Sub

Üstadım elinize sağlık, harika bir alternatif kod olmuş. Sağlıcakla kalın

 

[baydeniro]

Alternatif;

Son satır olarak 1000 değerini baz aldım. Sizde veri daha çoksa değiştirip kullanabilirsiniz.

Option Explicit

Sub Test()
    Dim X, Y
    X = Evaluate("MIN(IF(D2:D1000<>0,ROW(D2:D1000)))")
    Y = Evaluate("IFERROR(LOOKUP(2,1/(D2:D1000),ROW(D2:D1000)),0)")
    If X > 0 And Y > 0 Then
        Range("A" & X & ":D" & Y).Select
    Else
        MsgBox "Koşula uygun satır bulunamadı!", vbExclamation
    End If
End Sub

Üstadım elinize kolunuza sağlık, harika bir kod. Sağlıcakla kalın