En yakın değeri bulmak

[numan şamil]

Merhaba Arkadaşlar
Ekli örnek dosyada b sütunundaki değerler ile d sütununda değerleri eşleştirip eşit olanların karşılarında e sütununa "x" yazdırıyorum
Ancak d sütunundaki 170. satırda 1700 eşit olmadığından en yakın olan 1751 değerinin karşısına da "x" yazdırmak istiyorum satır ve rakamla değişken olabiliyor
Bunu nasıl yapabiliriz

 

[Korhan Ayhan]

Merhaba,

Dosyanızda 1700 verisi 73. satırda var.

Yine de yakın değer için aşağıdaki kodu deneyiniz.

Sub Aktar()
    Dim X As Long, Bul As Range, Adres As String, Aranan As Variant
    Application.ScreenUpdating = False
    Range("E5:E" & Rows.Count).ClearContents
    For X = 5 To Cells(Rows.Count, "B").End(3).Row
        Aranan = Cells(X, 2)
10      Set Bul = Range("D1").EntireColumn.Find(Aranan, , , xlWhole)
        If Not Bul Is Nothing Then
        Adres = Bul.Address
            Do
                If Bul.Offset(0, 1) = "" Then
                    Bul.Offset(0, 1) = "X"
                End If
                Set Bul = Range("D1").EntireColumn.FindNext(Bul)
            Loop While Not Bul Is Nothing And Bul.Address <> Adres
        Else
            Aranan = Application.WorksheetFunction.Lookup(Cells(X, 2), Range("D1").EntireColumn, Range("D1").EntireColumn)
            GoTo 10
        End If
    Next

    MsgBox "İşleminiz tamamlanmıştır."
End Sub

 

[numan şamil]

Merhaba,

Dosyanızda 1700 verisi 73. satırda var.

Yine de yakın değer için aşağıdaki kodu deneyiniz.

Sub Aktar()
    Dim X As Long, Bul As Range, Adres As String, Aranan As Variant
    Application.ScreenUpdating = False
    Range("E5:E" & Rows.Count).ClearContents
    For X = 5 To Cells(Rows.Count, "B").End(3).Row
        Aranan = Cells(X, 2)
10      Set Bul = Range("D1").EntireColumn.Find(Aranan, , , xlWhole)
        If Not Bul Is Nothing Then
        Adres = Bul.Address
            Do
                If Bul.Offset(0, 1) = "" Then
                    Bul.Offset(0, 1) = "X"
                End If
                Set Bul = Range("D1").EntireColumn.FindNext(Bul)
            Loop While Not Bul Is Nothing And Bul.Address <> Adres
        Else
            Aranan = Application.WorksheetFunction.Lookup(Cells(X, 2), Range("D1").EntireColumn, Range("D1").EntireColumn)
            GoTo 10
        End If
    Next

    MsgBox "İşleminiz tamamlanmıştır."
End Sub

Merhaba Korhan bey
Orjinalinde bir çok yerde 1700 var bur da Örn:1600 ile 1800 arasında 1700 olması gerekirken olmadığı için 1700 en yakın değer olan 1651 karşısına da "x " koymasını istiyorum Zaten bire bir eşit olanların karşısına " x" koyuyor
Denedim maalesef olmadı

 

[Korhan Ayhan]

Sanırım ben sorunuzu yanlış anladım.