Excel'le Adım Adım Program Yazma

Çevrimdışı yunushocam

  • Bilge Meclis Üyesi
  • *****
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
# 16 Nis 2017 12:37:26
Programı inceleyip değerlendirebilecekler var mı?

Çevrimdışı yunushocam

  • Bilge Meclis Üyesi
  • *****
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
# 16 Nis 2017 12:48:10
Dikey kelimelerin yazılması kodu


If yataydikey = 1 Then  'dikey
kelime = cevaplar(kar(b))
kelimeuzunluk = Len(kelime)

If kelimeuzunluk >= 10 Then GoTo yeniden
ymin = 3
ymax = 13 - kelimeuzunluk
xmin = 3
xmax = 14



'''''''''''''''''''''''''11111111111111111111111111111 1111111111111111111111111
If b = 1 Then
yeniden1:
x = aradasayi(xmax, xmin)
y = aradasayi(ymax, ymin)


If Cells(y - 1, x) <> "" Then GoTo yeniden1

f = "+"
k = 1
For a = 1 To kelimeuzunluk
If Cells(y + a - 1, x) <> "" And Cells(y + a - 1, x) <> Mid(kelime, a, 1) Then f = "-"
If Cells(y + a - 1, x) <> "" Then k = k + 1
Next a
If Cells(y + a - 1, x) <> "" Then GoTo yeniden1
If b > 1 And k = 1 Then GoTo yeniden1
If f = "-" Then GoTo yeniden1




For a = 1 To kelimeuzunluk
Cells(y + a - 1, x) = Mid(kelime, a, 1)
Next a
 Cells(y + a - 1, x) = "."

 
Cells(y - 1, x) = b
ActiveSheet.DrawingObjects("okasagi").Select
       Selection.Copy
       Cells(y - 1, x).Select
       ActiveSheet.Paste
 
End If
'''''''''''''''''''''''''11111111111111111111111111111 1111111111111111111


Çevrimdışı gokselgursu

  • Bilge Meclis Üyesi
  • *****
  • 3.992
  • 13.313
  • 3. Sınıf Öğretmeni
  • 3.992
  • 13.313
  • 3. Sınıf Öğretmeni
# 16 Nis 2017 21:29:07
Program hakkındaki görüşlerim

Çevrimdışı yunushocam

  • Bilge Meclis Üyesi
  • *****
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
# 18 Nis 2017 20:18:14
Merhabalar şu programı inceleyebilir misiniz, kendi hazırladığınız soru ve cevaplardan bulmaca hazırlayan bir program yaptım. Bütün öğretmenlere ulaşmak istiyorum. Şimdilik hazırlayan bilgisi ve site bilgisi korumalı, sadece site adı kalacak hazırlayan bilgisi sizin adınız olacak

[linkler sadece üyelerimize görünmektedir.]

Çevrimdışı yunushocam

  • Bilge Meclis Üyesi
  • *****
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
# 21 Nis 2017 23:03:03
Kelime avı programı, daha önce çengel bulmaca programını paylaşmıştım. Bu program da girdiğiniz sorularla bir kelime avı çalışması hazırlıyor. İleride kalan harflerden şifre çıkanı da yapmayı düşünüyorum. (yaptım ama bu formata yerleştirmek zaman alacak)

Programı inceleyip değerlendirme yaparsanız sevinirim. İlginiz için şimdiden teşekkürler.

[linkler sadece üyelerimize görünmektedir.]

Çevrimdışı tanju_62

  • Yeni Üye
  • 1
  • 0
  • 1
  • 0
# 05 Haz 2017 10:52:08
tebrikler elinize sağlık çok güzel olmuş benzeri birşey hazırlamak istiyorum vb kısmının parolasını verme imkanıınz varı tamamen inceleme amaclı tesekkurler

Çevrimdışı yunushocam

  • Bilge Meclis Üyesi
  • *****
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
# 06 Haz 2017 20:33:10
[linkler sadece üyelerimize görünmektedir.]
tebrikler elinize sağlık çok güzel olmuş benzeri birşey hazırlamak istiyorum vb kısmının parolasını verme imkanıınz varı tamamen inceleme amaclı tesekkurler


Şifreyi veremem amam kodları paylaşıyorum, buyurun,

Sub BulmacaHazirla()
ActiveSheet.PageSetup.RightFo oter = "Hazırlayan: Yunus KÜLCÜ"
 ActiveSheet.PageSetup.LeftFoo ter = " [linkler sadece üyelerimize görünmektedir.] "
 
 'hızlansın diye eklendi
   'Application.ScreenUpdating = False
   'Application.Calculation = xlCalculationManual
 'hızlansın diye eklendi

buyuksayac = 1
enbas:
buyuksayac = buyuksayac + 1
If buyuksayac > 10000 Then MsgBox "Başaramadık :(": GoTo enson
'temizlik
Range("a2:p25") = ""

  Dim Sh As Shape
   
    With ActiveSheet
   
        For Each Sh In .Shapes
            If Not Application.Intersect(Sh.TopLeftCell, .Range("a2:p25")) Is Nothing Then Sh.Delete
        Next Sh
       
    End With





On Error Resume Next






sorusayisi = Range("ae1")
sorulacakss = Range("ae2")
ReDim sorular(sorusayisi)
ReDim cevaplar(sorusayisi)
ReDim soruisaret(sorusayisi)
ReDim yazilansorular(sorulacakss)
ReDim yazilancevaplar(sorulacakss)

For a = 1 To sorusayisi
sorular(a) = Cells(a + 3, 18)
cevaplar(a) = Cells(a + 3, 29)
Next a


k = karisiksayi(kar, Int(sorulacakss), 1, Int(sorusayisi))




For b = 1 To sorulacakss
sayalim = 1
yeniden:

Randomize
yataydikey = Int(Rnd() * 2 + 1)
digerinabak: 'yatay bakı dikeye baksın veya tersi
soruisaret(kar(b)) = 1

 sayalim = sayalim + 1
 If sayalim > 3 Then GoTo enbas
 

If yataydikey = 1 Then  'dikey
kelime = cevaplar(kar(b))
kelimeuzunluk = Len(kelime)

If kelimeuzunluk >= 10 Then GoTo yeniden
ymin = 3
ymax = 13 - kelimeuzunluk
xmin = 3
xmax = 14



'''''''''''''''''''''''''11111111111111111111111111111 1111111111111111111111111
If b = 1 Then
yeniden1:
x = aradasayi(xmax, xmin)
y = aradasayi(ymax, ymin)


If Cells(y - 1, x) <> "" Then GoTo yeniden1

f = "+"
k = 1
For a = 1 To kelimeuzunluk
If Cells(y + a - 1, x) <> "" And Cells(y + a - 1, x) <> Mid(kelime, a, 1) Then f = "-"
If Cells(y + a - 1, x) <> "" Then k = k + 1
Next a
If Cells(y + a - 1, x) <> "" Then GoTo yeniden1
If b > 1 And k = 1 Then GoTo yeniden1
If f = "-" Then GoTo yeniden1




For a = 1 To kelimeuzunluk
Cells(y + a - 1, x) = Mid(kelime, a, 1)
Next a
 Cells(y + a - 1, x) = "."

 
Cells(y - 1, x) = b
ActiveSheet.DrawingObjects("okasagi").Select
       Selection.Copy
       Cells(y - 1, x).Select
       ActiveSheet.Paste
 
End If
'''''''''''''''''''''''''11111111111111111111111111111 1111111111111111111



If b > 1 Then
yazil = "-"
For xde = xmin To xmax
For yde = ymin To ymax

x = xde
y = yde



If Cells(y - 1, x) <> "" Then GoTo yeniden2

f = "+"
k = 1
For a = 1 To kelimeuzunluk
If Cells(y + a - 1, x) <> "" And Cells(y + a - 1, x) <> Mid(kelime, a, 1) Then f = "-"
If Cells(y + a - 1, x) <> "" Then k = k + 1
Next a
If Cells(y + a - 1, x) <> "" Then GoTo yeniden2
If b > 1 And k = 1 Then GoTo yeniden2
If f = "-" Then GoTo yeniden2




For a = 1 To kelimeuzunluk
Cells(y + a - 1, x) = Mid(kelime, a, 1)
Next a
 Cells(y + a - 1, x) = "."

 
Cells(y - 1, x) = b
ActiveSheet.DrawingObjects("okasagi").Select
       Selection.Copy
       Cells(y - 1, x).Select
       ActiveSheet.Paste
       yazil = "+"
GoTo yazdikatla1
yeniden2:
If yde = ymax And xde = xmax And yazil = "-" Then yataydikey = 2: GoTo digerinabak
 Next yde
Next xde
 End If
 
 
End If

yazdikatla1:






















If yataydikey = 2 Then 'yatay
kelime = cevaplar(kar(b))
kelimeuzunluk = Len(kelime)

If kelimeuzunluk >= 12 Then GoTo yeniden
xmin = 3
xmax = 15 - kelimeuzunluk
ymin = 3
ymax = 12




''''''''''''''''''''''22222222222222222222222222222 222222222222222222222222
If b = 1 Then
yeniden3:
x = aradasayi(xmax, xmin)
y = aradasayi(ymax, ymin)

If Cells(y, x - 1) <> "" Then GoTo yeniden3

k = 1
f = "+"
For a = 1 To kelimeuzunluk
If Cells(y, x + a - 1) <> "" And Cells(y, x + a - 1) <> Mid(kelime, a, 1) Then f = "-"
If Cells(y, x + a - 1) <> "" Then k = k + 1
Next a
If Cells(y, x + a - 1) <> "" Then GoTo yeniden3
If b > 1 And k = 1 Then GoTo yeniden3
If f = "-" Then GoTo yeniden3


For a = 1 To kelimeuzunluk
Cells(y, x + a - 1) = Mid(kelime, a, 1)
Next a
 Cells(y, x + a - 1) = "."

Cells(y, x - 1) = b
ActiveSheet.DrawingObjects("oksaga").Select
       Selection.Copy
       Cells(y, x - 1).Select
       ActiveSheet.Paste
       
 
 
End If




If b > 1 Then
yazil = "-"
For xde = xmin To xmax
For yde = ymin To ymax

x = xde
y = yde


If Cells(y, x - 1) <> "" Then GoTo yeniden4

k = 1
f = "+"
For a = 1 To kelimeuzunluk
If Cells(y, x + a - 1) <> "" And Cells(y, x + a - 1) <> Mid(kelime, a, 1) Then f = "-"
If Cells(y, x + a - 1) <> "" Then k = k + 1
Next a
If Cells(y, x + a - 1) <> "" Then GoTo yeniden4
If b > 1 And k = 1 Then GoTo yeniden4
If f = "-" Then GoTo yeniden4


For a = 1 To kelimeuzunluk
Cells(y, x + a - 1) = Mid(kelime, a, 1)
Next a
 Cells(y, x + a - 1) = "."

Cells(y, x - 1) = b
ActiveSheet.DrawingObjects("oksaga").Select
       Selection.Copy
       Cells(y, x - 1).Select
       ActiveSheet.Paste
       yazil = "+"
GoTo yazdikatla2

yeniden4:
If yde = ymax And xde = xmax And yazil = "-" Then yataydikey = 1: GoTo digerinabak
 Next yde
Next xde
End If


End If


yazdikatla2:

 



Cells(15, 1) = Cells(15, 1) & Chr(10) & b & ")" & sorular(kar(b))
 

Next b























'bitti noktaları kaldıralım
For a = 2 To 13
For b = 2 To 15

If Cells(a, b) = "." Then Cells(a, b) = ""

Next b
Next a


'yazılara boşluk koyalım
For a = 2 To 13
For b = 2 To 15
ne = ""
If Cells(a, b) >= 1 And Cells(a, b) < 1000 And Cells(a, b) <> "" Then ne = "sayi"
If Cells(a, b) <> "" And ne = "" Then Cells(a, b) = " "

Next b
Next a


enson:

  'hızlansın diye eklendi
  Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
  'hızlansın diye eklendi





End Sub





Bunlar da fonksiyonlar, hangileri kullanılıyor hatırlamıyorum, kullanılmayanlar olabilir



Function benzermi(diziadi As Variant, DiziTumElemanSayisi As Integer) As String

For a = 1 To DiziTumElemanSayisi
'don3:
'Randomize
'harfrakam(a) = Int(Rnd() * 10 + 1)
For b = 1 To DiziTumElemanSayisi
If a <> b And diziadi(a) = diziadi(b) And diziadi(a) <> "" Then
benzermi = "benzer"
GoTo 10
Else
benzermi = "benzer değil"
End If

Next b

Next a

10
End Function

Function karisiksayi(diziadi As Variant, kacsayi As Integer, altdeger As Integer, ustdeger As Integer)

ReDim diziadi(kacsayi)


For a = 1 To kacsayi
tekrar:
Randomize
diziadi(a) = Int(Rnd() * (ustdeger - altdeger + 1) + altdeger)
 
For b = 1 To kacsayi
If a <> b And diziadi(a) = diziadi(b) And diziadi(a) <> "" Then GoTo tekrar
Next b

Next a




End Function


Function yazilirmiy(konumx, konumy, kelime)
esitmi = "+"
x = konumx
y = konumy
uzunluk = Len(kelime)
say = 1

For a = 1 To uzunluk
If Cells(y, x + a - 1) <> "" And Cells(y, x + a - 1) <> Mid(kelime, a, 1) Then
esitmi = "-"
End If
If Cells(y, x + a - 1) <> "" Then say = say + 1
Next a
If say = 1 Then esitmi = "-"

yazilirmiy = esitmi



End Function
Function yazilirmid(konumx, konumy, kelime)
esitmi = "+"
x = konumx
y = konumy
uzunluk = Len(kelime)
say = 1

For a = 1 To uzunluk
If Cells(y + a - 1, x) <> "" And Cells(y + a - 1, x) <> Mid(kelime, a, 1) Then
esitmi = "-"
End If
If Cells(y + a - 1, x) <> "" Then say = say + 1
Next a
If say = 1 Then esitmi = "-"

yazilirmid = esitmi



End Function

Function aradasayi(buyuk, kucuk)
Randomize
aradasayi = Int(Rnd() * (buyuk - kucuk + 1) + kucuk)
End Function


Çevrimdışı yunushocam

  • Bilge Meclis Üyesi
  • *****
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
# 06 Haz 2017 21:01:48
[linkler sadece üyelerimize görünmektedir.]

Şifreyi veremem amam kodları paylaşıyorum, buyurun,

Sub BulmacaHazirla()
ActiveSheet.PageSetup.RightFo oter = "Hazırlayan: Yunus KÜLCÜ"
 ActiveSheet.PageSetup.LeftFoo ter = " [linkler sadece üyelerimize görünmektedir.] "
 
 'hızlansın diye eklendi
   'Application.ScreenUpdating = False
   'Application.Calculation = xlCalculationManual
 'hızlansın diye eklendi

buyuksayac = 1
enbas:
buyuksayac = buyuksayac + 1
If buyuksayac > 10000 Then MsgBox "Başaramadık :(": GoTo enson
'temizlik
Range("a2:p25") = ""

  Dim Sh As Shape
   
    With ActiveSheet
   
        For Each Sh In .Shapes
            If Not Application.Intersect(Sh.TopLeftCell, .Range("a2:p25")) Is Nothing Then Sh.Delete
        Next Sh
       
    End With





On Error Resume Next






sorusayisi = Range("ae1")
sorulacakss = Range("ae2")
ReDim sorular(sorusayisi)
ReDim cevaplar(sorusayisi)
ReDim soruisaret(sorusayisi)
ReDim yazilansorular(sorulacakss)
ReDim yazilancevaplar(sorulacakss)

For a = 1 To sorusayisi
sorular(a) = Cells(a + 3, 18)
cevaplar(a) = Cells(a + 3, 29)
Next a


k = karisiksayi(kar, Int(sorulacakss), 1, Int(sorusayisi))




For b = 1 To sorulacakss
sayalim = 1
yeniden:

Randomize
yataydikey = Int(Rnd() * 2 + 1)
digerinabak: 'yatay bakı dikeye baksın veya tersi
soruisaret(kar(b)) = 1

 sayalim = sayalim + 1
 If sayalim > 3 Then GoTo enbas
 

If yataydikey = 1 Then  'dikey
kelime = cevaplar(kar(b))
kelimeuzunluk = Len(kelime)

If kelimeuzunluk >= 10 Then GoTo yeniden
ymin = 3
ymax = 13 - kelimeuzunluk
xmin = 3
xmax = 14



'''''''''''''''''''''''''11111111111111111111111111111 1111111111111111111111111
If b = 1 Then
yeniden1:
x = aradasayi(xmax, xmin)
y = aradasayi(ymax, ymin)


If Cells(y - 1, x) <> "" Then GoTo yeniden1

f = "+"
k = 1
For a = 1 To kelimeuzunluk
If Cells(y + a - 1, x) <> "" And Cells(y + a - 1, x) <> Mid(kelime, a, 1) Then f = "-"
If Cells(y + a - 1, x) <> "" Then k = k + 1
Next a
If Cells(y + a - 1, x) <> "" Then GoTo yeniden1
If b > 1 And k = 1 Then GoTo yeniden1
If f = "-" Then GoTo yeniden1




For a = 1 To kelimeuzunluk
Cells(y + a - 1, x) = Mid(kelime, a, 1)
Next a
 Cells(y + a - 1, x) = "."

 
Cells(y - 1, x) = b
ActiveSheet.DrawingObjects("okasagi").Select
       Selection.Copy
       Cells(y - 1, x).Select
       ActiveSheet.Paste
 
End If
'''''''''''''''''''''''''11111111111111111111111111111 1111111111111111111



If b > 1 Then
yazil = "-"
For xde = xmin To xmax
For yde = ymin To ymax

x = xde
y = yde



If Cells(y - 1, x) <> "" Then GoTo yeniden2

f = "+"
k = 1
For a = 1 To kelimeuzunluk
If Cells(y + a - 1, x) <> "" And Cells(y + a - 1, x) <> Mid(kelime, a, 1) Then f = "-"
If Cells(y + a - 1, x) <> "" Then k = k + 1
Next a
If Cells(y + a - 1, x) <> "" Then GoTo yeniden2
If b > 1 And k = 1 Then GoTo yeniden2
If f = "-" Then GoTo yeniden2




For a = 1 To kelimeuzunluk
Cells(y + a - 1, x) = Mid(kelime, a, 1)
Next a
 Cells(y + a - 1, x) = "."

 
Cells(y - 1, x) = b
ActiveSheet.DrawingObjects("okasagi").Select
       Selection.Copy
       Cells(y - 1, x).Select
       ActiveSheet.Paste
       yazil = "+"
GoTo yazdikatla1
yeniden2:
If yde = ymax And xde = xmax And yazil = "-" Then yataydikey = 2: GoTo digerinabak
 Next yde
Next xde
 End If
 
 
End If

yazdikatla1:






















If yataydikey = 2 Then 'yatay
kelime = cevaplar(kar(b))
kelimeuzunluk = Len(kelime)

If kelimeuzunluk >= 12 Then GoTo yeniden
xmin = 3
xmax = 15 - kelimeuzunluk
ymin = 3
ymax = 12




''''''''''''''''''''''22222222222222222222222222222 222222222222222222222222
If b = 1 Then
yeniden3:
x = aradasayi(xmax, xmin)
y = aradasayi(ymax, ymin)

If Cells(y, x - 1) <> "" Then GoTo yeniden3

k = 1
f = "+"
For a = 1 To kelimeuzunluk
If Cells(y, x + a - 1) <> "" And Cells(y, x + a - 1) <> Mid(kelime, a, 1) Then f = "-"
If Cells(y, x + a - 1) <> "" Then k = k + 1
Next a
If Cells(y, x + a - 1) <> "" Then GoTo yeniden3
If b > 1 And k = 1 Then GoTo yeniden3
If f = "-" Then GoTo yeniden3


For a = 1 To kelimeuzunluk
Cells(y, x + a - 1) = Mid(kelime, a, 1)
Next a
 Cells(y, x + a - 1) = "."

Cells(y, x - 1) = b
ActiveSheet.DrawingObjects("oksaga").Select
       Selection.Copy
       Cells(y, x - 1).Select
       ActiveSheet.Paste
       
 
 
End If




If b > 1 Then
yazil = "-"
For xde = xmin To xmax
For yde = ymin To ymax

x = xde
y = yde


If Cells(y, x - 1) <> "" Then GoTo yeniden4

k = 1
f = "+"
For a = 1 To kelimeuzunluk
If Cells(y, x + a - 1) <> "" And Cells(y, x + a - 1) <> Mid(kelime, a, 1) Then f = "-"
If Cells(y, x + a - 1) <> "" Then k = k + 1
Next a
If Cells(y, x + a - 1) <> "" Then GoTo yeniden4
If b > 1 And k = 1 Then GoTo yeniden4
If f = "-" Then GoTo yeniden4


For a = 1 To kelimeuzunluk
Cells(y, x + a - 1) = Mid(kelime, a, 1)
Next a
 Cells(y, x + a - 1) = "."

Cells(y, x - 1) = b
ActiveSheet.DrawingObjects("oksaga").Select
       Selection.Copy
       Cells(y, x - 1).Select
       ActiveSheet.Paste
       yazil = "+"
GoTo yazdikatla2

yeniden4:
If yde = ymax And xde = xmax And yazil = "-" Then yataydikey = 1: GoTo digerinabak
 Next yde
Next xde
End If


End If


yazdikatla2:

 



Cells(15, 1) = Cells(15, 1) & Chr(10) & b & ")" & sorular(kar(b))
 

Next b























'bitti noktaları kaldıralım
For a = 2 To 13
For b = 2 To 15

If Cells(a, b) = "." Then Cells(a, b) = ""

Next b
Next a


'yazılara boşluk koyalım
For a = 2 To 13
For b = 2 To 15
ne = ""
If Cells(a, b) >= 1 And Cells(a, b) < 1000 And Cells(a, b) <> "" Then ne = "sayi"
If Cells(a, b) <> "" And ne = "" Then Cells(a, b) = " "

Next b
Next a


enson:

  'hızlansın diye eklendi
  Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
  'hızlansın diye eklendi





End Sub





Bunlar da fonksiyonlar, hangileri kullanılıyor hatırlamıyorum, kullanılmayanlar olabilir



Function benzermi(diziadi As Variant, DiziTumElemanSayisi As Integer) As String

For a = 1 To DiziTumElemanSayisi
'don3:
'Randomize
'harfrakam(a) = Int(Rnd() * 10 + 1)
For b = 1 To DiziTumElemanSayisi
If a <> b And diziadi(a) = diziadi(b) And diziadi(a) <> "" Then
benzermi = "benzer"
GoTo 10
Else
benzermi = "benzer değil"
End If

Next b

Next a

10
End Function

Function karisiksayi(diziadi As Variant, kacsayi As Integer, altdeger As Integer, ustdeger As Integer)

ReDim diziadi(kacsayi)


For a = 1 To kacsayi
tekrar:
Randomize
diziadi(a) = Int(Rnd() * (ustdeger - altdeger + 1) + altdeger)
 
For b = 1 To kacsayi
If a <> b And diziadi(a) = diziadi(b) And diziadi(a) <> "" Then GoTo tekrar
Next b

Next a




End Function


Function yazilirmiy(konumx, konumy, kelime)
esitmi = "+"
x = konumx
y = konumy
uzunluk = Len(kelime)
say = 1

For a = 1 To uzunluk
If Cells(y, x + a - 1) <> "" And Cells(y, x + a - 1) <> Mid(kelime, a, 1) Then
esitmi = "-"
End If
If Cells(y, x + a - 1) <> "" Then say = say + 1
Next a
If say = 1 Then esitmi = "-"

yazilirmiy = esitmi



End Function
Function yazilirmid(konumx, konumy, kelime)
esitmi = "+"
x = konumx
y = konumy
uzunluk = Len(kelime)
say = 1

For a = 1 To uzunluk
If Cells(y + a - 1, x) <> "" And Cells(y + a - 1, x) <> Mid(kelime, a, 1) Then
esitmi = "-"
End If
If Cells(y + a - 1, x) <> "" Then say = say + 1
Next a
If say = 1 Then esitmi = "-"

yazilirmid = esitmi



End Function

Function aradasayi(buyuk, kucuk)
Randomize
aradasayi = Int(Rnd() * (buyuk - kucuk + 1) + kucuk)
End Function




Kodlar dersli toplu değil, biliyorum, hatta kodlar içinde kullanılmayan bölümler de var. Zamanım olmadı düzenlemeye, siz incelemek isteyince kodları çıkarıp verdim. Saygılar.

Çevrimdışı dalorhan

  • Uzman Üye
  • *****
  • 285
  • 4.071
  • 285
  • 4.071
# 09 Haz 2017 00:49:04
[linkler sadece üyelerimize görünmektedir.]
Sayın hocam sınıf denemelerinde kullanacağım bir excell programı arıyorum. Aslında sitede buldum optixcell diye bir program yapmışlar.Ancak yapan arkadaş paralı yapmış.Burada herkes karşılıksız bilgi ve dosya paylaşırken para istemesi tuhafıma gitti.Programı inceledim, biraz geliştirilmesi lazım.Bahsettiğim programa benzer bir program yapmak için yardıma ihtiyacım var.
[linkler sadece üyelerimize görünmektedir.]

Çevrimdışı yunushocam

  • Bilge Meclis Üyesi
  • *****
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
# 06 Ağu 2017 13:53:11
1. Sınıf için çalışma hazırlarken güzel bir algoritma buldum. Tamamen otomatik olarak istediğiniz ritmik sayma çalışmasını hazırlıyor. İnceleyip yorum yapacak arkadaşlar var mıdır?

Not: Lütfen program başka sitelerde paylaşılmasın.

Çevrimdışı gokselgursu

  • Bilge Meclis Üyesi
  • *****
  • 3.992
  • 13.313
  • 3. Sınıf Öğretmeni
  • 3.992
  • 13.313
  • 3. Sınıf Öğretmeni
# 06 Ağu 2017 14:08:31
[linkler sadece üyelerimize görünmektedir.]
1. Sınıf için çalışma hazırlarken güzel bir algoritma buldum. Tamamen otomatik olarak istediğiniz ritmik sayma çalışmasını hazırlıyor. İnceleyip yorum yapacak arkadaşlar var mıdır?

Not: Lütfen program başka sitelerde paylaşılmasın.


Güzel bir program olmuş. Her sınıf seviyesine uygun üst limit verilirse daha iyi olur düşüncesindeyim.

Çevrimdışı yunushocam

  • Bilge Meclis Üyesi
  • *****
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
# 06 Ağu 2017 14:12:44
Üst limit var hocam, kimsenin kafasını karıştırmasın diye üstünü örttüm. (İleri geri bölümünün alt hücresinde). Yorumunuz için teşekkürler

Çevrimdışı yunushocam

  • Bilge Meclis Üyesi
  • *****
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
# 08 Ağu 2017 19:35:30
Apartmanlar oyunuyla yeni tanıştım, çok hoşuma gitti. İnternette yeterince örnek olmadığı için bir program yazmak istedim. Programın çoğu bitti, bir yerde tıkandım. İnternette bulunan örneklerde 3-4 ipucu veriliyor. Ben ise hangi ipuçlarının verileceğinin nasıl seçeceğimi bilemiyorum, bütün ipuçlarını veriyorum. Hangi ipuçlarının verileceği konusunda nasıl bir yol izlenebilir. Örnek çalışmamı sunuyorum. Umarım fikir verebilecek birileri çıkar.

Çevrimdışı yunushocam

  • Bilge Meclis Üyesi
  • *****
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
# 08 Ağu 2017 22:27:51
Aynı şekilde kullanılan örneklerde gördüm, bu şekilde de herhalde kullanılabilir. Aşağıdaki sitede benim örneğe benzer örnekler varmış.

[linkler sadece üyelerimize görünmektedir.]

Çevrimdışı yunushocam

  • Bilge Meclis Üyesi
  • *****
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
  • 1.645
  • 46.374
  • 3. Sınıf Öğretmeni
# 10 Ağu 2017 03:40:08
[linkler sadece üyelerimize görünmektedir.]
Apartmanlar oyunuyla yeni tanıştım, çok hoşuma gitti. İnternette yeterince örnek olmadığı için bir program yazmak istedim. Programın çoğu bitti, bir yerde tıkandım. İnternette bulunan örneklerde 3-4 ipucu veriliyor. Ben ise hangi ipuçlarının verileceğinin nasıl seçeceğimi bilemiyorum, bütün ipuçlarını veriyorum. Hangi ipuçlarının verileceği konusunda nasıl bir yol izlenebilir. Örnek çalışmamı sunuyorum. Umarım fikir verebilecek birileri çıkar.



Soruyu çözecek bir algoritma yazıyorum, sona yaklaştım. Başarabilirsem algoritma önce soruyu hazırlayacak sonra çözmeye çalışacak, eğer tıkanırsa yeni soru hazırlayıp onu çözmeye çalışacak. Çözülenler çalışma sayfasına eklenecek.

 


Egitimhane.Com ©2006-2023 KVKK