Hücre içinde virgül arama

[acemi1985]

Kolay Gelsin Ustadlar.

İngilizce kelime çalışmak için Bir program hazırladım.
userform üzerine birtane label birtanede textbox yerleştirdim labele ingilizce kelime geliyor textboxa türkçesini yazıyorum sayfada ingilizce kelimenin karşılığı textboxın verisi ise farklı kelime getiriyor.Ama bazı kelimelerin iki yada üç anlamı oluyor.örneğin Black=Siyah, Kara

Ben textboxa bu ikisinden yada üçünden birini yazdığımda geçsin istiyorum.
Bunu nasıl yapabilirim.
Şimdiden teşekkür ederim.

Dosya:

http://s3.dosya.tc/server13/v0xtkm/INGILIZCE_CALISMA.rar.html

 

[PLİNT]

Merhaba
"CEVAPLA" butonundaki kodları aşağıdaki gibi deneyin

[SIZE="2"]Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Str: Dim virg As Long, s As Long, f As String
virg = UBound(Split(Trim(Sayfa1.Cells(n, 2)), ","))
If virg > 0 Then
For s = 0 To virg
If Evaluate("=upper(""" & TextBox1.Text & """)") = Trim(Split(Trim(Sayfa1.Cells(n, 2)), ",")(s)) Then
f = "doğru"
End If
Next
End If
If f = "doğru" Or Evaluate("=upper(""" & TextBox1.Text & """)") = Trim(Sayfa1.Cells(n, 2)) Then
MsgBox "TEBRİKLER.Doğru Bildiniz.", vbInformation
Sayfa2.Select
Str = Sayfa2.Range("A65536").End(3).Row + 1
Sayfa2.Cells(Str, "A") = UCase(Label1.Caption)
Sayfa2.Cells(Str, "B") = UCase(TextBox1.Text)
Sayfa1.Select
Call kelime
TextBox1 = ""
Else
MsgBox "Yanlış.Lütfen Tekrar Deneyiniz!!.", vbCritical
TextBox1 = ""
TextBox1.SetFocus
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub[/SIZE]

(Profilinizde excel versiyonunu belirtmemişsiniz,eğer kullandığınızda "speak" özelliği varsa şu dosyayı deneyin ingilizce kelimeleri okur
http://www.dosya.tc/server11/5wsihy/INGILIZCE_CALISMA2.zip.html )
Aşağıdaki gibi de olabilir, ama burda virgül hesaba katılmaz,
"Kara" kelimesi için "Kar" yazarsanız kabul eder onun için yukarıdaki daha uygun

[SIZE="2"]Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Str: Dim ARA As String
[COLOR="Blue"]ARA = Evaluate("=upper(""" & TextBox1.Text & """)")
If Not Sayfa1.Cells(n, 2).Find(ARA, , xlFormulas, xlPart, , , False) Is Nothing Then[/COLOR]
MsgBox "TEBRİKLER.Doğru Bildiniz.", vbInformation
Sayfa2.Select
'.....
'...diğer kodlar
'....
[/SIZE]

 

[acemi1985]

Merhaba Sayın PİLNT kodu denedim çalışıyor, çok teşekkür ederim emeğinize sağlık.
"SPEAK" fikrini verdiğiniz için teşekkür ederim Çok güzel oldu.