• DİKKAT

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

Kelime Bulucu

M

mehmetaltin

Katılım
18 Kasım 2011
Mesajlar
406
Excel Vers. ve Dili
excel 2016 türkçe
Arkadaşlar ben ilkokul öğretmeniyim.Ben harfleri yazdığımda bu harfler ile oluşan tdk sözlüğünden kelime bulan(oluşturan) bir program hazırlanabilir mi?

Örneğin ben e-l-a-k-i-n harflerini yazdım bu harflerdenkelimeleri bulup yada oluşturacak...

ek
ak
iki
ela
kil...... gibi

Kelime listesi ektedir...
 

Ekli dosyalar

Son düzenleme:
Teşekkürler hocam.Ama benim istediğim bazen 3 harf için kelime ararken bazen 17 harf için kelime arayacağım.İlkokuma yazmada harf gruplarının sırasına göre.Ben 20.harfi öğretirken bu önce öğrendiği 20 harfi içeren kelimeler oluşturacak yada bulacak...
 
mehmetaltin' Alıntı:
Arkadaşlar ben ilkokul öğretmeniyim.Ben harfleri yazdığımda bu harfler ile oluşan tdk sözlüğünden kelime bulan(oluşturan) bir program hazırlanabilir mi?
Genişletmek için tıkla ...

Sayım MEMETALTIN,

Bahsettiğiniz kelimeleri nereden bulacak? Webden mi yoksa elinizde Excele aktarılmış TDK sözlüğü var mı? Sözlük varsa onun üzerinde çalışma yapılması gerekir.
 
Hocam 1.meseja kelime listesi ekledim.Araştırıyorum daha kapsamlı var mı diye...
 
Son düzenleme:
Arkadaşlar fikri olan var mı?Yada kullanabileceğim bildiğiniz site var mı?
 
mehmetaltin' Alıntı:
Arkadaşlar fikri olan var mı?Yada kullanabileceğim bildiğiniz site var mı?
Genişletmek için tıkla ...

Merhaba Hocam .

Benim bir fikrim var ama nasıl yapılacağını tam bilemiyorum.

Fikrim. a1-a2-a3..... seklinde hücrelere aranan harfleri yazmak. sonra ise bir for - next döngüsü ile TDK listesindeki kelimeleri tek tek bu şekilde taratmak. İçerisindeki harfin birtanesi bile bizim aranan harflere uyuşmayan kelime olursa pas geçmek.

bunun için yapılacak işlem önce aranan 1. harfi 2. harfi 3.....20 harfi hafızaya almak. sonra TDK da kaç kelime var son satırı bulup Bu son satıra kadar 1. for -nex döngüsü oluşturmak.

Daha sonra 1 kelimenin kaç karekterden oluştuğunu bulup son karaktere kadar hafızadaki harfleri sırayla uyuşuyormu diye bakmak eğer hepsi hafızadaki 1 harfle uyuşur ise sayfa 2 ye o kelimeyi yazdırmak uyuşmuyor ise diğer kelimeye geçen bir kodlama lazım.

Üzgünüm ki bunu yapacak bilgim yok . fakat sayfadaki abilerim için bence bu çocuk oyuncağı :)

Saygılar.
 
Arkadaşlar yardımcı olabilecek var mı acaba excel ile okuma yazma seti hazırlıyorum bu çok işime yarayacak..
 
Selamlar,
Aşağıdaki örneği deneyiniz. İsteğinizi yerine getiriyor. Yalnız işlem 1-2 dakika sürebiliyor.
Sarı hücreye arama yapacağınız harfleri yazınız. Kelimeler C sütununa listelenecektir.
Kod: 
Sub KelimeBul()
Zaman = Timer
Columns(3).ClearContents
For x = 1 To 65536
klm = Cells(x, 1)
uklm = Len(klm)
For y = 1 To uklm
hrf = Mid(klm, y, 1)
sor = InStr(1, [b1], hrf)
If sor > 0 Then
say = say + 1
End If
Next
If uklm = say Then
sat = sat + 1
Cells(sat, "c") = klm
End If
say = 0
Next
Bitis = Chr(10) & "İşlemin tamamlanma süresi: " & Format(Timer - Zaman, "00:00") & " dakika"
MsgBox "İşlem tamamlandı." & Bitis, vbOKOnly, "l e u m r u k"
End Sub
 

Ekli dosyalar

Kod çok özenli değil ama işinizi görür. Yıllar önce yazmıştım :)

Aşağıdaki kodu deneyin, 40 karakter 65000 kelime 4 saniyede sonucu verir.
Süre bilgisayarın özellikllerine göre değişiklik gösterebilir.

Kod: 
Sub harflerden_kelime_turet1()
   Range("E1").Value = Now

   Application.ScreenUpdating = False
   Application.EnableEvents = False
 
   Range("D:D").ClearContents
   Range("B:B").ClearContents
 
   referansturet = buyukharf(Range("C1").Value)
   For i = 1 To 100000
    kelimeler(i, 1) = ""
    kelimeler(i, 2) = ""
   Next i
   
    sonsatirturet = Range("A" & Rows.Count).End(xlUp).Row
    Range("B1").FormulaR1C1 = "=LEN(RC[-1])"
    Range("B1").AutoFill Destination:=Range("B1:B" & sonsatirturet)
    Columns("B:B").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B1").Select
    Application.CutCopyMode = False
   
    Columns("A:B").Select
    Range("B1").Activate
    ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range( _
        "B1:B65535"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range( _
        "A1:A65535"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
        .SetRange Range("A1:B65535")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
      
       For Z = 1 To sonsatirturet
         kelimeler(Z, 1) = buyukharf(Cells(Z, "A").Value)
       Next Z
son:
  
  sayturet = 0
   For Z = 1 To sonsatirturet
       kelimetext = kelimeler(Z, 1)

       If Len(kelimetext) > Len(referansturet) Then
          kelimeler(Z, 2) = "X"
          GoTo sonz
       End If
      
       If kelimetext = "" Then
          Exit For
       End If
      
       gecici = kelimetext
       For j1 = 1 To Len(referansturet)
           harfref = Mid(referansturet, j1, 1)
           gecici = Replace(gecici, harfref, "", 1, 1)
       Next j1

       If gecici <> "" Then
          kelimeler(Z, 2) = "X"
       End If
sonz:

   Next Z
   satir = 0
   For Z = 1 To sonsatirturet
     If kelimeler(Z, 2) <> "X" Then
        satir = satir + 1
        Cells(satir, "D").Value = kelimeler(Z, 1)
     End If
   Next Z
Range("F1").Value = Now
Range("E1:F1").NumberFormat = "h:mm:ss"
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Public Function buyukharf(cumle)
gecici = ""
For i = 1 To Len(cumle)
          h = Mid(cumle, i, 1)
          Select Case h
            Case "ğ": gecici = gecici + "Ğ"
            Case "ü": gecici = gecici + "Ü"
            Case "ş": gecici = gecici + "Ş"
            Case "ç": gecici = gecici + "Ç"
            Case "ö": gecici = gecici + "Ö"
            Case "ı": gecici = gecici + "I"
            Case "i": gecici = gecici + "İ"
            Case Else: gecici = gecici + UCase(h)
            End Select
Next i
buyukharf = gecici
End Function
 

Ekli dosyalar

Merhaba Mehmet Altın Arkadaşım,
İlkokul 1. sınıf öğrencileri için, verilen kelimenin harfleri ile oluşturulabilecek (karakter sayısına bağlı olarak) 1 karakterli, 2 karakterli, 3 karakterli, ... , kelimenin kendisine kadar tüm anlamlı kelimelerin oluşturulmasının öğrencinin kelime ufkunu genişletmesi bakımından çok daha anlamlı olduğunu bizzat kendi çocuklarım ve öğrencilerim üzerinde denediğim için biliyorum.
Örneğin yaptığımız bir denemede "sonbahar kelimesinin (8 karakter) harfleriyle kaç kelime üretilir?" sorusunun cevabı farklı sınıflarda farklı olmuş ve 30 civarında kalmıştı. Halbuki inceleyin, 70 in üzerinde olduğunu göreceksiniz. Sizin örneğinizdeki farklı kalıplar arasından çocukların çoğunun hiç kullanmadıkları, duymadıkları kelimeleri anlamaları ve bulup söylemeleri ne kadar anlamlıdır, bilemem.
Saygılarımla
 
Merhaba, kelime oyunları oynarken çok zorlandığım da kelimelen.com un kelime bulucu alanını kullanıyorum. Harflere göre sıralama yapıyor. Başlayan, biten ve içerisinde geçen seçenekleri mevcut.
 
Konuyu ADO ile yapabilirmiyim diye biraz uğraştım.
Sayfa1'de A sütununda Kelime listesi var.
Sayfa2'de A1 hücresinde boşluksuz ve aralarında özel bir işaret olmadan içerilmesi istenen harfler var.
Veriler Sayfa2'de G Sütununa geliyor.
Deneme yanılma yolu ile uğraşırken yanlışlıkla "*" yerine "%" kullandım, işe yaradı. ("*" işe yaramıyor.)
G Sütunundaki veriler arasına nedenini anlamadığım bir şekilde Birer adet "DOĞRU" ve "YANLIŞ" ifadeleri ekliyor.
Kod: 
Sub KelimeOyunu()
Dim Con As Object, Rs As Object, Sorgu As String
Columns("G:G").ClearContents
metin = Range("a1")
harf = "a b c ç d e f g ğ h i ı j k l m n o ö p r s ş t u ü v y z"
harf = Split(harf, " ")
If Len(metin) = 29 Then
Sorgu = "SELECT* FROM [Sayfa1$]"
Else
For i = 0 To UBound(harf)
If InStr(1, metin, harf(i)) = 0 Then
yharf = yharf & harf(i)
End If
Next
Sorgu = "Select* From [Sayfa1$] Where liste Not Like '%[" & yharf & "]%'"
End If
Set Con = CreateObject("AdoDB.Connection")
Set Rs = CreateObject("AdoDB.RecordSet")
Con.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";Extended Properties=""Excel 12.0;Hdr=yes"""
Rs.Open Sorgu, Con, 1, 1
Range("G1").CopyFromRecordset Rs
Rs.Close: Con.Close
Sorgu = vbNullString: Set Rs = Nothing: Set Con = Nothing
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst