Soru İki satır arasındaki farkı bulma

[Eda_mavi122223]

Merhaba,

A1 satırına MAVİ yazdım. B1 satırına Mvi yazdım.
B1 sütununda bulunan verinin A1 sütunundan farkını bulma formülünü nasıl yazabilirm.
Yani c1 satırına "a" harfini çıkarmalı.
Yardımlarınızı bekliyorum.
Teşekkürler

 

[mesudiye_052]

Merhabalar;

Dizi formül
Ctrl + Shift + Enter tuşlarına birlikte basınız

formül yalnızca ilk farklı olanı bulur birden fazla farklı varsa ikinciyi bulmaz

=PARÇAAL(A1;KAÇINCI(0;--(İNDİS(ÖZDEŞ(PARÇAAL(KÜÇÜKHARF(A1);SATIR(DOLAYLI("1:"&UZUNLUK(A1)));1);PARÇAAL(KÜÇÜKHARF(B1);SATIR(DOLAYLI("1:"&UZUNLUK(A1)));1));0;0));0);1)

 

[Eda_mavi122223]

Maalesef formül çalışmıyor

 

[Eda_mavi122223]

Merhabalar;

Dizi formül
Ctrl + Shift + Enter tuşlarına birlikte basınız

formül yalnızca ilk farklı olanı bulur birden fazla farklı varsa ikinciyi bulmaz

=PARÇAAL(A1;KAÇINCI(0;--(İNDİS(ÖZDEŞ(PARÇAAL(KÜÇÜKHARF(A1);SATIR(DOLAYLI("1:"&UZUNLUK(A1)));1);PARÇAAL(KÜÇÜKHARF(B1);SATIR(DOLAYLI("1:"&UZUNLUK(A1)));1));0;0));0);1)

Maalesef formül çalışmıyor. Lütfen yine bakabilir misiniz?

 

[mesudiye_052]

Formülün içinde iken ctrl + shift +enter tuşlarına elinizi çekmeden sıra ile basınız

 

[Eda_mavi122223]

Formülün içinde iken ctrl + shift +enter tuşlarına elinizi çekmeden sıra ile basınız

Çok çok teşekkür ederim peki birden fazla hatalı harfi bulabileceğim bir formül biliyor musunuz?

 

[Eda_mavi122223]

bir harften fazla uyuşmama durumu olduğunda hücreyi boş bıraksa ya da #yok gibi bir uyarı verse.. çünkü benim için bir harf hatasını bulmak çok çok önemli

 

[mesudiye_052]

Merhabalar

Option Explicit
Option Explicit
Sub harfBul()

Dim ws As Worksheet
Dim cll As Range

Dim arr1() As Variant
Dim arr2() As Variant
Dim lr, i, j, k As Long
Dim str As String


Set ws = ThisWorkbook.ActiveSheet
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1

ReDim arr1(1 To lr, 1 To 1)
ReDim arr2(1 To lr, 1 To 1)

arr1 = ws.Range("A1:A" & lr)
arr2 = ws.Range("B1:B" & lr)

For i = LBound(arr1) To UBound(arr1)
    k = 0
    For j = 1 To Len(arr1(i, 1))
        k = k + 1
        If LCase(Mid(arr1(i, 1), j, 1)) <> LCase(Mid(arr2(i, 1), k, 1)) Then
            k = k - 1
            str = str & LCase(Mid(arr1(i, 1), j, 1))
        End If
        ws.Cells(i, "C") = str
    Next j
    str = ""
Next i


Set ws = Nothing
Set cll = Nothing


End Sub

 

[mesudiye_052]

Merhabalar

Bunu kullanınız

Option Explicit
Sub harfBul()

Dim ws As Worksheet
Dim cll As Range

Dim arr1() As Variant
Dim arr2() As Variant
Dim lr, i, j, k As Long
Dim arr3() As Variant


Set ws = ThisWorkbook.ActiveSheet
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1

ReDim arr1(1 To lr, 1 To 1)
ReDim arr2(1 To lr, 1 To 1)
ReDim arr3(1 To lr, 1 To 1)

arr1 = ws.Range("A1:A" & lr)
arr2 = ws.Range("B1:B" & lr)

For i = LBound(arr1) To UBound(arr1)
    k = 0
    For j = 1 To Len(arr1(i, 1))
        k = k + 1
        If LCase(Mid(arr1(i, 1), j, 1)) <> LCase(Mid(arr2(i, 1), k, 1)) Then
            k = k - 1
            arr3(i, 1) = arr3(i, 1) & LCase(Mid(arr1(i, 1), j, 1))
        End If
      
    Next j
     
Next i
ws.Range("C1:C" & lr) = arr3

Set ws = Nothing
Set cll = Nothing
Erase arr1
Erase arr2
Erase arr3

End Sub

 

[Eda_mavi122223]

Allah razı olsun diyorum.. Harikasınız :*

 

[Eda_mavi122223]

a

Merhabalar

Bunu kullanınız

Option Explicit
Sub harfBul()

Dim ws As Worksheet
Dim cll As Range

Dim arr1() As Variant
Dim arr2() As Variant
Dim lr, i, j, k As Long
Dim arr3() As Variant


Set ws = ThisWorkbook.ActiveSheet
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1

ReDim arr1(1 To lr, 1 To 1)
ReDim arr2(1 To lr, 1 To 1)
ReDim arr3(1 To lr, 1 To 1)

arr1 = ws.Range("A1:A" & lr)
arr2 = ws.Range("B1:B" & lr)

For i = LBound(arr1) To UBound(arr1)
    k = 0
    For j = 1 To Len(arr1(i, 1))
        k = k + 1
        If LCase(Mid(arr1(i, 1), j, 1)) <> LCase(Mid(arr2(i, 1), k, 1)) Then
            k = k - 1
            arr3(i, 1) = arr3(i, 1) & LCase(Mid(arr1(i, 1), j, 1))
        End If
     
    Next j
    
Next i
ws.Range("C1:C" & lr) = arr3

Set ws = Nothing
Set cll = Nothing
Erase arr1
Erase arr2
Erase arr3

End Sub

Aslında bu formül ile hatalı olan harfi bulma sadece ilk satırda çalışıyorken sonraki satırlarda hatalı harften sonraki tüm harfleri getiriyor. Sadece hatalı harfi getirebilmesi için formülde nereyi revize etmeliyim?

 

[mesudiye_052]

Merhabalar

Option Explicit
Sub harfBul()

Dim ws As Worksheet
Dim cll As Range
Dim arr1() As Variant
Dim arr2() As Variant
Dim arr3() As Variant
Dim str1() As String
Dim str2() As String
Dim lr, i, j, k As Long
Dim sayac As Integer


Set ws = ThisWorkbook.ActiveSheet
lr = ws.Cells(Rows.Count, "A").End(xlUp).row + 1

ReDim arr1(1 To lr, 1 To 1)
ReDim arr2(1 To lr, 1 To 1)
ReDim arr3(1 To lr, 1 To 1)

arr1 = ws.Range("A1:A" & lr)
arr2 = ws.Range("B1:B" & lr)

For i = LBound(arr1) To UBound(arr1)
    str1 = Split(Application.Trim(UCase(Replace(Replace(arr1(i, 1), "ı", "I"), _
    "i", "İ"))))
    
    str2 = Split(Application.Trim(UCase(Replace(Replace(arr2(i, 1), "ı", "I"), _
    "i", "İ"))))
    
    For j = LBound(str1) To UBound(str1)
       sayac = 0
       For k = LBound(str2) To UBound(str2)
            If str1(j) = str2(k) Then
                 sayac = sayac + 1
            End If
       Next k
       If sayac = 0 Then
            arr3(i, 1) = arr3(i, 1) & " " & str1(j)
          
       End If
    Next j
    
Next i
ws.Range("C1:C" & lr) = arr3

Set ws = Nothing
Set cll = Nothing
Erase arr1
Erase arr2
Erase arr3

End Sub