En Yakın Benzer Veriyi Bulmak

baydeniro · 21 Ekim 2020

Merhaba Arkadaşlar,
En son veriye 1 farkla benzeyen ilk veriyi bulmak mümkün mü ?
10. veriye en yakın veri 8. satırda. Ama bazen 3., başka bir veri diziliminde 6. satırda olabilir !

kulomer46 · 21 Ekim 2020

Merhaba

Ekli dosya taleplerinizi karşılayabilir.

Selamlar...

İlgili resim

baydeniro · 21 Ekim 2020

kulomer46' Alıntı:
Merhaba

Ekli dosya taleplerinizi karşılayabilir.

Selamlar...

İlgili resim
Ekli dosyayı görüntüle 222102

kulomer46 üstadım çok teşekkür ederim. Harika bir kod, sağlıcakla kalın

kulomer46 · 21 Ekim 2020

baydeniro' Alıntı:
kulomer46 üstadım çok teşekkür ederim. Harika bir kod, sağlıcakla kalın

Kolay gelsin..

baydeniro · 21 Ekim 2020

kulomer46' Alıntı:
Kolay gelsin..

üstad geçerkten çok harika bir çalışma, elinize sağlık. acaba kontrol yönünü yukarıdan aşağıya yapmak için kodu nasıl revize etmeliyim

Korhan Ayhan · 21 Ekim 2020

Alternatif;

C++:

Option Explicit

Sub En_Yakini_Bul()
    Dim Son As Long, Aranan As String, Yeni_Aranan As String
    Dim Bul As Range, X As Integer, WF As WorksheetFunction
   
    Set WF = WorksheetFunction
   
    Son = Cells(Rows.Count, 2).End(3).Row
    Aranan = Cells(Son, 2).Value
   
    Set Bul = Range("B:B").Find(Aranan, , , xlWhole)
   
    If Not Bul Is Nothing Then
        If Bul.Row <> Son Then
            MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
            Exit Sub
        Else
            Yeni_Aranan = "?" & Left(Aranan, Len(Aranan) - 1)
            Set Bul = Range("B:B").Find(Yeni_Aranan, , , xlWhole)
            If Not Bul Is Nothing Then
                If Bul.Row <> Son Then
                    MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
                    Exit Sub
                End If
            End If
           
            Yeni_Aranan = Right(Aranan, Len(Aranan) - 1) & "?"
            Set Bul = Range("B:B").Find(Yeni_Aranan, , , xlWhole)
            If Not Bul Is Nothing Then
                If Bul.Row <> Son Then
                    MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
                    Exit Sub
                End If
            End If
           
            For X = 1 To Len(Aranan)
                Yeni_Aranan = WF.Replace(Aranan, X, 1, "?")
                Set Bul = Range("B:B").Find(Yeni_Aranan, , , xlWhole)
                If Not Bul Is Nothing Then
                    If Bul.Row <> Son Then
                        MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
                        Exit Sub
                    End If
                End If
            Next
        End If
    End If
   
    Set Bul = Nothing
    Set WF = Nothing

    MsgBox "En yakın eşleşme bulunamadı!", vbCritical
End Sub

baydeniro · 21 Ekim 2020

Korhan Ayhan' Alıntı:

Alternatif;

C++:

Option Explicit

Sub En_Yakini_Bul()
    Dim Son As Long, Aranan As String, Yeni_Aranan As String
    Dim Bul As Range, X As Integer, WF As WorksheetFunction
  
    Set WF = WorksheetFunction
  
    Son = Cells(Rows.Count, 2).End(3).Row
    Aranan = Cells(Son, 2).Value
  
    Set Bul = Range("B:B").Find(Aranan, , , xlWhole)
  
    If Not Bul Is Nothing Then
        If Bul.Row <> Son Then
            MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
            Exit Sub
        Else
            Yeni_Aranan = "?" & Left(Aranan, Len(Aranan) - 1)
            Set Bul = Range("B:B").Find(Yeni_Aranan, , , xlWhole)
            If Not Bul Is Nothing Then
                If Bul.Row <> Son Then
                    MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
                    Exit Sub
                End If
            End If
          
            Yeni_Aranan = Right(Aranan, Len(Aranan) - 1) & "?"
            Set Bul = Range("B:B").Find(Yeni_Aranan, , , xlWhole)
            If Not Bul Is Nothing Then
                If Bul.Row <> Son Then
                    MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
                    Exit Sub
                End If
            End If
          
            For X = 2 To Len(Aranan)
                Yeni_Aranan = WF.Replace(Aranan, X, 1, "?")
                Set Bul = Range("B:B").Find(Yeni_Aranan, , , xlWhole)
                If Not Bul Is Nothing Then
                    If Bul.Row <> Son Then
                        MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
                        Exit Sub
                    End If
                End If
            Next
        End If
    End If
  
    Set Bul = Nothing
    Set WF = Nothing

    MsgBox "En yakın eşleşme bulunamadı!", vbCritical
End Sub

Üstad çok teşekkür ediyorum. elinize sağlık.
acaba sıralamayı yukarıdan aşağı olarak yapabilir miyiz ! yani B1 hücresini baz alarak aşağıya doğru

Korhan Ayhan · 21 Ekim 2020

Zaten o şekilde arama yapar.

baydeniro · 21 Ekim 2020

Korhan Ayhan' Alıntı:
Zaten o şekilde arama yapar.

üstad kastettiğim yön farkı şöyle

kulomer46 · 22 Ekim 2020

Merhaba

Ek 'teki dosya işinizi görebilir.

Selamlar...

İlgili Resim

Korhan Ayhan · 22 Ekim 2020

Ben de kendi paylaştığım kodu aşağıdaki gibi revize ettim. Deneyin bakalım istediğiniz sonucu verecek mi?

C++:

Option Explicit

Sub En_Yakini_Bul()
    Dim Aranan As String, Yeni_Aranan As String
    Dim Bul As Range, X As Integer, WF As WorksheetFunction
    
    Set WF = WorksheetFunction
    
    Aranan = Cells(1, 2).Value
    
    Set Bul = Range("B:B").Find(Aranan, , , xlWhole)
    
    If Not Bul Is Nothing Then
        If Bul.Row <> 1 Then
            MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
            Exit Sub
        Else
            Yeni_Aranan = "?" & Left(Aranan, Len(Aranan) - 1)
            Set Bul = Range("B:B").Find(Yeni_Aranan, , , xlWhole)
            If Not Bul Is Nothing Then
                If Bul.Row <> 1 Then
                    MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
                    Exit Sub
                End If
            End If
            
            Yeni_Aranan = Right(Aranan, Len(Aranan) - 1) & "?"
            Set Bul = Range("B:B").Find(Yeni_Aranan, , , xlWhole)
            If Not Bul Is Nothing Then
                If Bul.Row <> 1 Then
                    MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
                    Exit Sub
                End If
            End If
            
            For X = 1 To Len(Aranan)
                Yeni_Aranan = WF.Replace(Aranan, X, 1, "?")
                Set Bul = Range("B:B").Find(Yeni_Aranan, , , xlWhole)
                If Not Bul Is Nothing Then
                    If Bul.Row <> 1 Then
                        MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
                        Exit Sub
                    End If
                End If
            Next
        End If
    End If
    
    Set Bul = Nothing
    Set WF = Nothing

    MsgBox "En yakın eşleşme bulunamadı!", vbCritical
End Sub

baydeniro · 22 Ekim 2020

kulomer46' Alıntı:
Merhaba

Ek 'teki dosya işinizi görebilir.

Selamlar...

İlgili Resim
Ekli dosyayı görüntüle 222113

Çok teşekkür ederim üstadım, emeğiniz sağlık. Bu şekilde gayet iyi çalışıyor.
Bir de şu olsaydı muhteşem olurdu : Yukarıdan aşağıya doğru en alttaki benzeyen veri

baydeniro · 22 Ekim 2020

Korhan Ayhan' Alıntı:

Ben de kendi paylaştığım kodu aşağıdaki gibi revize ettim. Deneyin bakalım istediğiniz sonucu verecek mi?

C++:

Option Explicit

Sub En_Yakini_Bul()
    Dim Aranan As String, Yeni_Aranan As String
    Dim Bul As Range, X As Integer, WF As WorksheetFunction
   
    Set WF = WorksheetFunction
   
    Aranan = Cells(1, 2).Value
   
    Set Bul = Range("B:B").Find(Aranan, , , xlWhole)
   
    If Not Bul Is Nothing Then
        If Bul.Row <> 1 Then
            MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
            Exit Sub
        Else
            Yeni_Aranan = "?" & Left(Aranan, Len(Aranan) - 1)
            Set Bul = Range("B:B").Find(Yeni_Aranan, , , xlWhole)
            If Not Bul Is Nothing Then
                If Bul.Row <> 1 Then
                    MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
                    Exit Sub
                End If
            End If
           
            Yeni_Aranan = Right(Aranan, Len(Aranan) - 1) & "?"
            Set Bul = Range("B:B").Find(Yeni_Aranan, , , xlWhole)
            If Not Bul Is Nothing Then
                If Bul.Row <> 1 Then
                    MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
                    Exit Sub
                End If
            End If
           
            For X = 1 To Len(Aranan)
                Yeni_Aranan = WF.Replace(Aranan, X, 1, "?")
                Set Bul = Range("B:B").Find(Yeni_Aranan, , , xlWhole)
                If Not Bul Is Nothing Then
                    If Bul.Row <> 1 Then
                        MsgBox "Aranan veri " & Bul.Row & ". satırda bulundu!" & vbLf & vbLf & Bul.Value, vbExclamation
                        Exit Sub
                    End If
                End If
            Next
        End If
    End If
   
    Set Bul = Nothing
    Set WF = Nothing

    MsgBox "En yakın eşleşme bulunamadı!", vbCritical
End Sub

Çok teşekkür ederim üstadım, emeğiniz sağlık. Bu şekilde gayet iyi çalışıyor.
Bir de şu olsaydı muhteşem olurdu : Yukarıdan aşağıya doğru en alttaki benzeyen veri

En Yakın Benzer Veriyi Bulmak

baydeniro

Ekli dosyalar

kulomer46

Ekli dosyalar

baydeniro

kulomer46

baydeniro

Korhan Ayhan

Administrator

baydeniro

Korhan Ayhan

Administrator

baydeniro

kulomer46

Ekli dosyalar

Korhan Ayhan

Administrator

baydeniro

baydeniro