En Yakın Benzer Veriyi Bulmak

B

baydeniro

Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Altın Üyelik Bitiş Tarihi
20-02-2025
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 !

222098
 

Ekli dosyalar

kulomer46

kulomer46

Altın Üye
Katılım
23 Mart 2007
Mesajlar
1,514
Excel Vers. ve Dili
Microsoft Office LTSC Professional Plus 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
08-06-2027
Merhaba

Ekli dosya taleplerinizi karşılayabilir.

Selamlar...

İlgili resim
222102
 

Ekli dosyalar

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,742
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
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
 
B

baydeniro

Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Altın Üyelik Bitiş Tarihi
20-02-2025
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
Genişletmek için tıkla ...
Ü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
 
kulomer46

kulomer46

Altın Üye
Katılım
23 Mart 2007
Mesajlar
1,514
Excel Vers. ve Dili
Microsoft Office LTSC Professional Plus 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
08-06-2027
Merhaba

Ek 'teki dosya işinizi görebilir.

Selamlar...

İlgili Resim
222113
 

Ekli dosyalar

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,742
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
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
 
B

baydeniro

Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Altın Üyelik Bitiş Tarihi
20-02-2025
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
Genişletmek için tıkla ...
Ç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 :)
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst