Yerleri farklı ama aynı karakter sayıdaki verileri karşılaştırmak

baydeniro · 2 Ocak 2021

Merhaba Arkadaşlar;
Görseldeki gibi sonuçları makro ile almak mümkün mü ?
1.kelime ile 2.kelimedeki harfler aynı ama yerleri değişikse EŞİT, 1 harf bile farklı ise DEĞİL sonucu almak.

ÖmerFaruk · 2 Ocak 2021

Uzunluklar da eşit olmak zorunda mı?

baydeniro · 2 Ocak 2021

NextLevel' Alıntı:
Uzunluklar da eşit olmak zorunda mı?

ilginize teşekkür ederim NextLEvel üstadım. Evet uzunluklar daima eşit olacak. Ama uzunlukların eşit olmama durumu kodlama açısından avantaj sağlıyorsa fark etmez.

ÖmerFaruk · 2 Ocak 2021

Deneyiniz. Hata varsa düzeltelim.

C++:

Sub Karşılaştır()
For i = 2 To Range("B" & Rows.Count).End(3).Row
    If Len(Range("B" & i)) <> Len(Range("C" & i)) Then GoTo DEĞİL
    For k = 1 To Len(Range("B" & i))
        If Len(Replace(Range("B" & i), Mid(Range("B" & i), i, 1), "")) <> _
        Len(Replace(Range("C" & i), Mid(Range("B" & i), i, 1), "")) Then GoTo DEĞİL
    Next k
    Range("D" & i) = "eşit"
    GoTo DEVAM
DEĞİL:
    Range("D" & i) = "değil"
DEVAM:
Next i
End Sub

baydeniro · 2 Ocak 2021

NextLevel' Alıntı:

Deneyiniz. Hata varsa düzeltelim.

C++:

Sub Karşılaştır()
For i = 2 To Range("B" & Rows.Count).End(3).Row
    If Len(Range("B" & i)) <> Len(Range("C" & i)) Then GoTo DEĞİL
    For k = 1 To Len(Range("B" & i))
        If Len(Replace(Range("B" & i), Mid(Range("B" & i), i, 1), "")) <> _
        Len(Replace(Range("C" & i), Mid(Range("B" & i), i, 1), "")) Then GoTo DEĞİL
    Next k
    Range("D" & i) = "eşit"
    GoTo DEVAM
DEĞİL:
    Range("D" & i) = "değil"
DEVAM:
Next i
End Sub

üstad teşekkür ederim. Beklenen sonuç bu değil ama bu kodun da kullanılabileceği yerler hakkında çağrışım yaptı. teşekkür ederim.
Bu kod; aynı uzunluktaki 2 veride 1 harf bile benziyorsa EŞİT diyor. Ama beklenen sonuç, 2 veride 1 harf bile benMEziyorsa "DEĞİL" demesi!

ÖmerFaruk · 2 Ocak 2021

Ben deniyorum, dediğiniz gibi sonuç almıyorum.
"2 veride 1 harf bile benMEziyorsa "DEĞİL" demesi!" Yazdığım kodda da geçerli
Hata verdiğini söylediğiniz kelimeleri ya da exceli paylaşır mısınız?

baydeniro · 2 Ocak 2021

NextLevel' Alıntı:
Ben deniyorum, dediğiniz gibi sonuç almıyorum.
"2 veride 1 harf bile benMEziyorsa "DEĞİL" demesi!" Yazdığım kodda da geçerli
Hata verdiğini söylediğiniz kelimeleri ya da exceli paylaşır mısınız?

teşekkürler NextLEvel üstad. Örnek dosya ekledim.

ÖmerFaruk · 2 Ocak 2021

If Len(Replace(Range("B" & i), Mid(Range("B" & i), k, 1), "")) <> _
Len(Replace(Range("C" & i), Mid(Range("B" & i), k, 1), "")) Then GoTo DEĞİL

IF satırını yukarıdakiyle değiştirin.

baydeniro · 2 Ocak 2021

NextLevel' Alıntı:
If Len(Replace(Range("B" & i), Mid(Range("B" & i), k, 1), "")) <> _
Len(Replace(Range("C" & i), Mid(Range("B" & i), k, 1), "")) Then GoTo DEĞİL

IF satırını yukarıdakiyle değiştirin.

çok teşekkür ederim üstadım, şimdi oldu. Diğeri de bir yerde işe yarayacaktır. 2 harika kod için sağ olun var olun, sağlıcakla kalın

Necdet · 2 Ocak 2021

Merhaba,

Bir seçenek te benden. Her iki sözcük karmaşıkta olsa büyük küçük harfte bile karşılaştırma yapar.

Kod:

Sub Karşılaştır()

    Dim i   As Long, _
        t1  As String, _
        t2  As String
   
    For i = 2 To Range("B" & Rows.Count).End(3).Row
        t1 = SozcukSrl(Cells(i, "B"))
        t2 = SozcukSrl(Cells(i, "C"))
        Cells(i, "D") = t1 = t2
    Next i

End Sub

Kod:

Function SozcukSrl(Txt)

  Dim arr
  Dim strTemp As String
  Dim i As Integer
  Dim j As Integer
  Dim lngMin As Integer
  Dim lngMax As Integer

  Txt = Application.WorksheetFunction.Trim(Txt)
  Txt = UCase(Replace(Replace(Txt, "i", "İ"), "ı", "I"))

  ReDim arr(1 To Len(Txt))

  For i = 1 To Len(Txt)
    arr(i) = Mid(Txt, i, 1)
  Next i

  lngMin = LBound(arr)
  lngMax = UBound(arr)

  For i = lngMin To lngMax - 1
    For j = i + 1 To lngMax
      If arr(i) > arr(j) Then
        strTemp = arr(i)
        arr(i) = arr(j)
        arr(j) = strTemp
      End If
    Next j
  Next i
   
    Txt = ""
    For i = 1 To UBound(arr)
        Txt = Txt & arr(i)
    Next i
   
    SozcukSrl = Txt
   
End Function

veyselemre · 2 Ocak 2021

Kod:

Sub Test()

    For i = 2 To Range("B" & Rows.Count).End(3).Row
        al1 = Range("B" & i).Value
        al2 = Range("C" & i).Value

        Do While al1 <> ""
            If Len(al1) = Len(al2) Then
                deg = Left(al1, 1)
                al1 = Replace(al1, deg, "")
                al2 = Replace(al2, deg, "")
                If Len(al1) < 2 And al1 = al2 Then
                    Cells(i, "E").Value = "EŞİT"
                    GoTo DEVAM
                End If
            Else
                Exit Do
            End If
        Loop

        Cells(i, "E").Value = "DEĞİL"
DEVAM:
    Next i
End Sub

baydeniro · 2 Ocak 2021

veyselemre' Alıntı:

Kod:

Sub Test()

    For i = 2 To Range("B" & Rows.Count).End(3).Row
        al1 = Range("B" & i).Value
        al2 = Range("C" & i).Value

        Do While al1 <> ""
            If Len(al1) = Len(al2) Then
                deg = Left(al1, 1)
                al1 = Replace(al1, deg, "")
                al2 = Replace(al2, deg, "")
                If Len(al1) < 2 And al1 = al2 Then
                    Cells(i, "E").Value = "EŞİT"
                    GoTo DEVAM
                End If
            Else
                Exit Do
            End If
        Loop

        Cells(i, "E").Value = "DEĞİL"
DEVAM:
    Next i
End Sub

veyselemre üstadım elinize, aklınıza sağlık. Harika bir kod. Güçlü bir alternatifimiz oldu. Sağlıcakla kalın

baydeniro · 2 Ocak 2021

Necdet' Alıntı:

Merhaba,

Bir seçenek te benden. Her iki sözcük karmaşık olsa bile karşılaştırma yapar.

Kod:

Sub Karşılaştır()

    Dim i   As Long, _
        t1  As String, _
        t2  As String
   
    For i = 2 To Range("B" & Rows.Count).End(3).Row
        t1 = SozcukSrl(Cells(i, "B"))
        t2 = SozcukSrl(Cells(i, "C"))
        Cells(i, "D") = t1 = t2
    Next i

End Sub

Kod:

Function SozcukSrl(Txt)

  Dim arr
  Dim strTemp As String
  Dim i As Integer
  Dim j As Integer
  Dim lngMin As Integer
  Dim lngMax As Integer

  Txt = Application.WorksheetFunction.Trim(Txt)
  Txt = UCase(Replace(Replace(Txt, "i", "İ"), "ı", "I"))

  ReDim arr(1 To Len(Txt))

  For i = 1 To Len(Txt)
    arr(i) = Mid(Txt, i, 1)
  Next i

  lngMin = LBound(arr)
  lngMax = UBound(arr)

  For i = lngMin To lngMax - 1
    For j = i + 1 To lngMax
      If arr(i) > arr(j) Then
        strTemp = arr(i)
        arr(i) = arr(j)
        arr(j) = strTemp
      End If
    Next j
  Next i
   
    Txt = ""
    For i = 1 To UBound(arr)
        Txt = Txt & arr(i)
    Next i
   
    SozcukSrl = Txt
   
End Function

Necdet Yeşertener üstadım, muhteşem bir kod daha. Elinize, aklınıza sağlık. KTF modunu da içeren mükemmel bir alternatifimiz daha oldu. Sağlıcakla kalın

Korhan Ayhan · 2 Ocak 2021

Alternatif;

KTF ile çözüm dosyası ektedir.

veyselemre · 2 Ocak 2021

Büyük/küçük dikkate almadan eşitliğini kontrol eder.

Kod:

Sub Test()
    For i = 2 To Range("B" & Rows.Count).End(3).Row
        al1 = UCase(Replace(Replace(Range("B" & i).Value, "i", "İ"), "ı", "I"))
        al2 = UCase(Replace(Replace(Range("C" & i).Value, "i", "İ"), "ı", "I"))
        sonuc = "EŞİT DEĞİL"
        Do While al1 <> "" And Len(al1) = Len(al2)
            deg = Left(al1, 1)
            al1 = Replace(al1, deg, "")
            al2 = Replace(al2, deg, "")
            If al1 = al2 Then
                sonuc = "EŞİT"
                Exit Do
            End If
        Loop
        Cells(i, "E").Value = sonuc
    Next i
End Sub

Necdet · 2 Ocak 2021

baydeniro' Alıntı:
Necdet Yeşertener üstadım, muhteşem bir kod daha. Elinize, aklınıza sağlık. KTF modunu da içeren mükemmel bir alternatifimiz daha oldu. Sağlıcakla kalın

Merhaba,

Doğrudan KTF olarak ta kullanabilirsiniz.

Kod:

=SozcukSrl(A1)=SozcukSrl(B1)

gibi.

baydeniro · 3 Ocak 2021

Korhan Ayhan' Alıntı:
Alternatif;

KTF ile çözüm dosyası ektedir.

Korhan Ayhan, üstadım çok teşekkür ederim. Elinize, emeğinize sağlık. Müthiş bir alternatifimiz oldu. Sağlıcakla kalın.

baydeniro · 3 Ocak 2021

Necdet' Alıntı:
Merhaba,

Doğrudan KTF olarak ta kullanabilirsiniz.

Kod:

=SozcukSrl(A1)=SozcukSrl(B1)

gibi.

Hatırlatma için çok teşekkür ederim üstadım, sağlıklı günler dilerim

baydeniro · 3 Ocak 2021

veyselemre' Alıntı:

Büyük/küçük dikkate almadan eşitliğini kontrol eder.

Kod:

Sub Test()
    For i = 2 To Range("B" & Rows.Count).End(3).Row
        al1 = UCase(Replace(Replace(Range("B" & i).Value, "i", "İ"), "ı", "I"))
        al2 = UCase(Replace(Replace(Range("C" & i).Value, "i", "İ"), "ı", "I"))
        sonuc = "EŞİT DEĞİL"
        Do While al1 <> "" And Len(al1) = Len(al2)
            deg = Left(al1, 1)
            al1 = Replace(al1, deg, "")
            al2 = Replace(al2, deg, "")
            If al1 = al2 Then
                sonuc = "EŞİT"
                Exit Do
            End If
        Loop
        Cells(i, "E").Value = sonuc
    Next i
End Sub

veyselemre üstadım, bu 2. kod da harika oldu. Gerektiğine birini, başka bir durumda diğerini kullanabiliriz. Emeğinize sağlık.

Yerleri farklı ama aynı karakter sayıdaki verileri karşılaştırmak

baydeniro

ÖmerFaruk

Destek Ekibi

baydeniro

ÖmerFaruk

Destek Ekibi

baydeniro

ÖmerFaruk

Destek Ekibi

baydeniro

Ekli dosyalar

ÖmerFaruk

Destek Ekibi

baydeniro

Necdet

Moderatör

veyselemre

Özel Üye

baydeniro

baydeniro

Korhan Ayhan

Administrator

Ekli dosyalar

veyselemre

Özel Üye

Necdet

Moderatör

baydeniro

baydeniro

baydeniro