Değere Göre Veri Taşıma

[pisagor26]

Değerli arkadaşlar okulumuzda yapılan deneme sınavları devam ederken bu sınavlardaki başarı puanlarına göre yerleşebilecekleri okulları görmek adına bir çalışma yapmak istiyorum. Ekteki çalışmada "a4" sayfasında yer alan öğrenci puan bilgisine göre yerleşebileceği okulları (puanı yeterli olan) "veri_x" sayfasından çekip örnekte olduğu gibi araya virgül koyarak yazmamızı sağlayan nasıl bir formül oluşturabiliriz...

 

[Astalavista58]

Bu kod işinizi görür diye umuyorum.

Sub VeriCekme()
    Dim A4 As Worksheet
    Dim Veri_x As Worksheet
    Dim ArananDeger As Double
    Dim Cikti As String
    Dim Sonuc As Range
    Dim Hucresi As Range
    
    Set A4 = ThisWorkbook.Sheets("A4")
    Set Veri_x = ThisWorkbook.Sheets("Veri_x")

    ArananDeger = A4.Range("B2").Value
    
    Cikti = ""
    
    Set Sonuc = Veri_x.Range("C1").End(xlDown)
    
    For Each Hucresi In Veri_x.Range("C1:C" & Sonuc.Row)
            If Cikti = "" Then
                Cikti = Veri_x.Cells(Hucresi.Row, "B").Value
            Else
                Cikti = Cikti & ", " & Veri_x.Cells(Hucresi.Row, "B").Value
            End If
        End If
    Next Hucresi
    
    A4.Range("C2").Value = Cikti
End Sub