Eşleştirme Harflerini Kodda Çalıştırmak

[baydeniro]

Merhaba Arkadaşlar,
Aşağıdaki resimde görülen veriler ve kodun mantığı şöyledir;
E2 hücresindeki şehir isminde bulunan harflerin uzunluğunu E3 hücresine (en fazla 10 olabilir) hesaplayıp, sözcüğü parçalayıp E4:E13 hücrelerine harfler halinde yazıyor.
Parçalanan harflerin karşılıklarını K4:L13 alanında belirleyip F4:F13 hücrelerine yazıyor. Karşılığı olmayan harflerin hepsi için L14 hücresindeki "X" harfini kullanıyor.

Harfleri parçalama işini ve karşılık harflerini hücrelere yazılmadan kodun içinde halledilebilir mi ?

C++:
Sub CITIES()
Range("E4:F13") = ""
Range("E3") = "=LEN(R2C5)"
Range("E4:E" & [E3] + 3) = "=MID(R2C,ROW()-3,1)"
Range("F4:F" & [E3] + 3) = "=IFERROR(VLOOKUP(RC[-1],R4C11:R13C12,2,0),R14C12)"
Range("E3:F" & [E3] + 3).Value = Range("E3:F" & [E3] + 3).Value
End Sub

 

[ÖmerFaruk]

Sub CITIES_2()
Range("E4:F13") = ""
For i = 1 To WorksheetFunction.Min(Len(Range("E2")), 10)
    Range("E" & i + 3) = Mid(Range("E2"), i, 1)
    If Not IsError(Application.Match(Range("E" & i + 3), Range("K4:K13"), 0)) Then
        Range("F" & i + 3) = Range("L" & 3 + Application.Match(Range("E" & i + 3), Range("K4:K13"), 0))
    Else
        Range("F" & i + 3) = Range("L14")
    End If
Next i
End Sub

 

[ÖmerBey]

Merhaba,
Ben soruyu biraz farklı anladım galiba, alternatif olsun...

Sub Kod()
m = Array("A", "B", "C", "H", "L", "M", "O", "S", "T", "U")
y = Array("H", "A", "M", "B", "U", "R", "G", "C", "T", "Y")
se = Range("E2").Value
ReDim sy(1 To Len(se))
For a = LBound(sy) To UBound(sy)
    For b = LBound(m) To UBound(m)
        If Mid(se, a, 1) = m(b) Then
            sy(a) = y(b)
            GoTo 1
        End If
    Next
    sy(a) = "X"
1
Next
MsgBox Join(sy, "")
End Sub

 

[baydeniro]

Sub CITIES_2()
Range("E4:F13") = ""
For i = 1 To WorksheetFunction.Min(Len(Range("E2")), 10)
    Range("E" & i + 3) = Mid(Range("E2"), i, 1)
    If Not IsError(Application.Match(Range("E" & i + 3), Range("K4:K13"), 0)) Then
        Range("F" & i + 3) = Range("L" & 3 + Application.Match(Range("E" & i + 3), Range("K4:K13"), 0))
    Else
        Range("F" & i + 3) = Range("L14")
    End If
Next i
End Sub

üstad kod için çok teşekkür ederim. elinize sağlık.
yapmaya çalıştığımız konuda algoritmayı biraz değiştirdik. acaba bu konuda desteğiniz olabilir mi ?

Hazırladığımız kod şöyle:
Sub CITIES_1()
Range("E2") = "=RANDBETWEEN(1,4)&RANDBETWEEN(1,4)&RANDBETWEEN(1,4)&RANDBETWEEN(1,4)"
Range("E2").Value = Range("E2").Value
Range("F4:F" & [E3] + 3) = "=INDEX({""A"",""B"",""C"",""D""},0,MID(R2C5,ROW()-3,1))"
Range("F3:F" & [E3] + 3).Value = Range("F3:F" & [E3] + 3).Value
End Sub

Bu kod şöyle çalışıyor :
* E2 hücresinde 4 basamaklı ve 1-2-3-4 rakamlarından oluşan rastgele bir sayı üretiyor.
* Daima 4 basamak olacağı için LEN saydırmasına gerek kalmayacak.
* F4:F7 alanında E3 hücresindeki rakamları 1 parçaya ayırıp
* INDEX ile A-B-C-D karşılığını buluyor ve
* F2 hücresinde birleştiriyor. Buraya kadar sorun yok, gayet iyi çalışan basit bir kod yazdık.

Ama şu olabilir mi ?
F4:F7 hücrelerini kullanmadan E2 hücresindeki sayıların HARF karşılığını F2 hücresine yazdırabilir miyiz ?
F4:F7 by passlamasını YERİNEKOY ile de yapabiliriz ama karakter sayısının artması ihtimalinde çok uzun bir formül olacağı için tercih etmedik. Daha işlevsel bir çözüm olabilir mi ?

 

[baydeniro]

Merhaba,
Ben soruyu biraz farklı anladım galiba, alternatif olsun...

Sub Kod()
m = Array("A", "B", "C", "H", "L", "M", "O", "S", "T", "U")
y = Array("H", "A", "M", "B", "U", "R", "G", "C", "T", "Y")
se = Range("E2").Value
ReDim sy(1 To Len(se))
For a = LBound(sy) To UBound(sy)
    For b = LBound(m) To UBound(m)
        If Mid(se, a, 1) = m(b) Then
            sy(a) = y(b)
            GoTo 1
        End If
    Next
    sy(a) = "X"
1
Next
MsgBox Join(sy, "")
End Sub

Üstad bu kıymetli kod düzenlemeniz için çok teşekkür ederim. Bunu değerlendireceğim. Algoritmada bir miktar değişim yaptım. Ona bir göz atarsanız çok memnun olurum.

 

[ÖmerBey]

Deneyiniz...

Sub kod()
Dim s(1 To 4)
Dim m(1 To 4)
For a = LBound(s) To UBound(s)
    s(a) = Evaluate("=RANDBETWEEN(1,4)")
    m(a) = Mid("ABCD", s(a), 1)
Next
Range("E1").Value = Join(s, "")
Range("F1").Value = Join(m, "")
End Sub

 

[Korhan Ayhan]

Alternatif;

Sub Test()
    Sayi = Evaluate("=RANDBETWEEN(1,4)&RANDBETWEEN(1,4)&RANDBETWEEN(1,4)&RANDBETWEEN(1,4)")
    Range("E2") = Sayi
    Range("F2") = Replace(Replace(Replace(Replace(Sayi, 1, "A"), 2, "B"), 3, "C"), 4, "D")
End Sub

 

[baydeniro]

Deneyiniz...

Sub kod()
Dim s(1 To 4)
Dim m(1 To 4)
For a = LBound(s) To UBound(s)
    s(a) = Evaluate("=RANDBETWEEN(1,4)")
    m(a) = Mid("ABCD", s(a), 1)
Next
Range("E1").Value = Join(s, "")
Range("F1").Value = Join(m, "")
End Sub

üstad harika bir kod olmuş. mucizevi elinize aklınıza sağlık
Dim s(1 To 4) yerine kendi belirlediğim sayıyı ekleyebilmek için çeşitli denemeler yaptım ama beceremedim. Benim belirlediğim sayı C2 hücresinde olsa kodu nasıl revize etmek lazım üstadım ?
Dim s As Range
s = Range("E2")

 

[ÖmerBey]

Kendi belirlediğiniz sayı derken?
Sayılar rastgele oluşturulmuyor mu? Yoksa kastettiğiniz basamak sayısı mı?

 

[baydeniro]

Kendi belirlediğiniz sayı derken?
Sayılar rastgele oluşturulmuyor mu? Yoksa kastettiğiniz basamak sayısı mı?

üstad ilginize çok teşekkürler. sonradan düşününce o fikirden vzgeçtim. bu haliyle zaten mükemmel. sağ olun, var olun, sağlıcakla kalın

 

[baydeniro]

Alternatif;

Sub Test()
    Sayi = Evaluate("=RANDBETWEEN(1,4)&RANDBETWEEN(1,4)&RANDBETWEEN(1,4)&RANDBETWEEN(1,4)")
    Range("E2") = Sayi
    Range("F2") = Replace(Replace(Replace(Replace(Sayi, 1, "A"), 2, "B"), 3, "C"), 4, "D")
End Sub

çok teşekkürler istadım, sağlıcakla kalın.