• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

B

baydeniro

Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
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

224030
 

Ekli dosyalar

C++: 
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
 
Merhaba,
Ben soruyu biraz farklı anladım galiba, alternatif olsun...
Kod: 
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
 
NextLevel' Alıntı:
C++: 
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
Genişletmek için tıkla ...
ü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 ?
 

Ekli dosyalar

ÖmerBey' Alıntı:
Merhaba,
Ben soruyu biraz farklı anladım galiba, alternatif olsun...
Kod: 
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
Genişletmek için tıkla ...
Ü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.
 
Deneyiniz...
Kod: 
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
 
Alternatif;

C++: 
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
 
ÖmerBey' Alıntı:
Deneyiniz...
Kod: 
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
Genişletmek için tıkla ...
ü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")
 
Kendi belirlediğiniz sayı derken?
Sayılar rastgele oluşturulmuyor mu? Yoksa kastettiğiniz basamak sayısı mı?
 
Korhan Ayhan' Alıntı:
Alternatif;

C++: 
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
Genişletmek için tıkla ...
çok teşekkürler istadım, sağlıcakla kalın.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst