Listede belirlenen değere en yakın değerleri bulmak

[tamer42]

Merhabalar,
Ekli dosyada "B" sütununda yer alan bir değer dizisinde;

örnek: 270 degerine göre; sütun içerinde 270' e en yakın 6 degerin hangileri olduğunu nasıl bulabiliriz?


Teşekkürler,
iyi pazarlar.

 

[ÖmerFaruk]

Aşağıdaki kodları kullanabilrisiniz.

Sub AltıDeger()
Dim Dizi, TempVal As Double
    Dizi = Range("B2:B" & Range("A" & Rows.Count).End(3).Row).Value
    For a = LBound(Dizi) To (UBound(Dizi) - 1)
        For b = (a + 1) To UBound(Dizi)
            If Abs(Dizi(a, 1) - Range("D1")) > Abs(Dizi(b, 1) - Range("D1")) Then
                TempVal = Dizi(b, 1)
                Dizi(b, 1) = Dizi(a, 1)
                Dizi(a, 1) = TempVal
                TempVal = Empty
            End If
        Next b
    Next a
    Range("D2").Resize(6, 1) = Dizi
End Sub

Benim aldığım sonuç

 

[tamer42]

Aşağıdaki kodları kullanabilrisiniz.

Sub AltıDeger()
Dim Dizi, TempVal As Double
    Dizi = Range("B2:B" & Range("A" & Rows.Count).End(3).Row).Value
    For a = LBound(Dizi) To (UBound(Dizi) - 1)
        For b = (a + 1) To UBound(Dizi)
            If Abs(Dizi(a, 1) - Range("D1")) > Abs(Dizi(b, 1) - Range("D1")) Then
                TempVal = Dizi(b, 1)
                Dizi(b, 1) = Dizi(a, 1)
                Dizi(a, 1) = TempVal
                TempVal = Empty
            End If
        Next b
    Next a
    Range("D2").Resize(6, 1) = Dizi
End Sub

Benim aldığım sonuç
Ekli dosyayı görüntüle 231152

Ömer Hocam teşekkürler,
"B" sütununda bazen sayısal ifadeler olmayabilir, bu nedenle bu satırları atlamak gerekiyor.

Bu nedenle dizi oluşturmada aşağıdaki kodu yazdım fakat hata verdi.

bu konuda da yardımcı olabilir misiniz

k = 1

ss = Range("A" & Rows.Count).End(3).Row

ReDim Dizi(1)

    '''Dizi = Range("B2:B" & ss).Value
   
    For i = 2 To ss
   
        If IsNumeric(Range("B" & i)) Then
       
                Dizi(k) = Range("B" & i)
   
            k = k + 1
           
         ReDim Preserve Dizi(k)
           
        End If
   
   
    Next i

 

[ÖmerFaruk]

Aşağıdaki haliyle yapabilirsin.

Sub AltıDeger()
Dim Dizi, TempVal As Double
    Son = Range("A" & Rows.Count).End(3).Row
    ReDim Dizi(1 To 1, 1 To Son - 1)
    For i = 2 To Son
        If IsNumeric(Range("B" & i)) Then
            Say = Say + 1
            Dizi(1, Say) = Range("B" & i)
        End If
    Next i
    ReDim Preserve Dizi(1 To 1, 1 To Say)
    For a = LBound(Dizi, 2) To (UBound(Dizi, 2) - 1)
        For b = (a + 1) To UBound(Dizi, 2)
            If Abs(Dizi(1, a) - Range("D1")) > Abs(Dizi(1, b) - Range("D1")) Then
                TempVal = Dizi(1, b)
                Dizi(1, b) = Dizi(1, a)
                Dizi(1, a) = TempVal
                TempVal = Empty
            End If
        Next b
    Next a
    For i = 1 To 6
        Range("D1").Offset(i, 0) = Dizi(1, i)
    Next i
End Sub

 

[tamer42]

Aşağıdaki haliyle yapabilirsin.

Sub AltıDeger()
Dim Dizi, TempVal As Double
    Son = Range("A" & Rows.Count).End(3).Row
    ReDim Dizi(1 To 1, 1 To Son - 1)
    For i = 2 To Son
        If IsNumeric(Range("B" & i)) Then
            Say = Say + 1
            Dizi(1, Say) = Range("B" & i)
        End If
    Next i
    ReDim Preserve Dizi(1 To 1, 1 To Say)
    For a = LBound(Dizi, 2) To (UBound(Dizi, 2) - 1)
        For b = (a + 1) To UBound(Dizi, 2)
            If Abs(Dizi(1, a) - Range("D1")) > Abs(Dizi(1, b) - Range("D1")) Then
                TempVal = Dizi(1, b)
                Dizi(1, b) = Dizi(1, a)
                Dizi(1, a) = TempVal
                TempVal = Empty
            End If
        Next b
    Next a
    For i = 1 To 6
        Range("D1").Offset(i, 0) = Dizi(1, i)
    Next i
End Sub

çok teşekkürler, iyi ki varsınız

 

[Korhan Ayhan]

ADO ile alternatif;

 

[tamer42]

ADO ile alternatif;

İlginize teşekkürler Korhan Hocam