Oppure

Loading
12/03 10:51
maurizio74
Ciao a tutti, provando ad implementare il calcolo enigmatico che avevo posto quache giorno fa, di cui Carlo mi ha dato una grande mano, mi sono accorto che il programma ha qualche falla nel senso che non funge come dovrebbe:

questo è il codice funzionante del programma realizzato con 5 numeri:

Dim fatto As Boolean

Private Sub Command1_click()
Dim i As Long
Dim arr(1 To 5) As Variant
fatto = False ' azzera la variabile booleana
For i = 1 To 5
arr(i) = i

Next


Call permutazioni(arr, 5, 5)

End Sub

Sub permutazioni(vettore() As Variant, dimensione As Long, n As Long)

Dim i As Long
If fatto Then Exit Sub ' termina la ricorsione

If dimensione = 1 Then
fatto = risultato(vettore) ' memorizzo in fatto il valore booleano

Exit Sub
End If

For i = 1 To dimensione
Call permutazioni(vettore(), dimensione - 1, n)
If dimensione Mod 2 = 1 Then
Call Scambio(vettore(), 1, dimensione)
Else
Call Scambio(vettore(), i, dimensione)
End If

Next

End Sub


Sub Scambio(arr() As Variant, indice1 As Long, indice2 As Long)

Dim temp_var As Variant

temp_var = arr(indice1)
arr(indice1) = arr(indice2)
arr(indice2) = temp_var

End Sub


Function risultato(vettore()) As Boolean

Dim value As Integer ' conterrà la somma delle uguaglianze
' riempimento Text (celle)
TextO1 = vettore(1)
TextO2 = vettore(2)
TextO3 = vettore(3)
TextO4 = vettore(4)
TextO5 = vettore(5)
Text01 = vettore(1)
Text02 = vettore(2)
Text03 = vettore(3)
Text04 = vettore(4)
Text05 = vettore(5)
' riga 4
TextC4 = TextO1
TextD4 = TextO2
TextF4 = TextO3
TextI4 = TextO1
TextJ4 = TextO4

' riga 7
TextD7 = TextO2
TextF7 = TextO4
TextJ7 = TextO3

'riga10
TextD10 = TextO3
TextF10 = TextO1
TextJ10 = TextO5

' verifica


' riga 14
TextD14 = TextC4 & TextD4
TextF14 = TextF4
TextH14 = TextI4 & TextJ4
If CInt(TextD14) - CInt(TextF14) - CInt(TextH14) = 0 Then TextJ14 = "VERO": value = value + 1 Else TextJ14 = "FALSO"

' riga 15
TextD15 = TextD7
TextF15 = TextF7
TextH15 = TextJ7
If CInt(TextD15) - CInt(TextF15) - CInt(TextH15) = 0 Then TextJ15 = "VERO": value = value + 1 Else TextJ15 = "FALSO"

' riga 16
TextD16 = TextD10
TextF16 = TextF10
TextH16 = TextJ10
If CInt(TextD16) + CInt(TextF16) - CInt(TextH16) = 0 Then TextJ16 = "VERO": value = value + 1 Else TextJ16 = "FALSO"

' riga 17
TextD17 = TextC4 & TextD4
TextF17 = TextD7
TextH17 = TextD10
If CInt(TextD17) - CInt(TextF17) * CInt(TextH17) = 0 Then TextJ17 = "VERO": value = value + 1 Else TextJ17 = "FALSO"

' riga 18
TextD18 = TextF4
TextF18 = TextF7
TextH18 = TextF10
If CInt(TextD18) - CInt(TextF18) - CInt(TextH18) = 0 Then TextJ18 = "VERO": value = value + 1 Else TextJ18 = "FALSO"

' riga 19
TextD19 = TextI4 & TextJ4
TextF19 = TextJ7
TextH19 = TextJ10
If CInt(TextD19) - CInt(TextF19) * CInt(TextH19) = 0 Then TextJ19 = "VERO": value = value + 1 Else TextJ19 = "FALSO"

' riga 20
TextJ20 = value

If TextJ20 = 6 Then
risultato = True
Else
risultato = False
End If

DoEvents ' per vedere la progressione

End Function
ed in allegato la foto dei textbox disposti nel programma.
Ultima modifica effettuata da maurizio74 12/03 10:53
aaa
12/03 11:05
maurizio74
nell' implementazione che non ho fatto altro che modificare la parte del command1 come potete vedere:

Dim fatto As Boolean

Private Sub Command1_click()
Dim i As Long
Dim arr(1 To 7) As Variant
fatto = False ' azzera la variabile booleana
For i = 1 To 7
arr(i) = i

Next


Call permutazioni(arr, 7, 7)

End Sub

e la parte della function che gestisce i textbox:

 Function risultato(vettore()) As Boolean


Dim value As Integer ' conterrà la somma delle uguaglianze
' riempimento Text (celle)
TextO1 = vettore(1)
TextO2 = vettore(2)
TextO3 = vettore(3)
TextO4 = vettore(4)
TextO5 = vettore(5)
TextO6 = vettore(6)
TextO7 = vettore(7)

TextO1 = vettore(1)
TextO2 = vettore(2)
TextO3 = vettore(3)
TextO4 = vettore(4)
TextO5 = vettore(5)
TextO6 = vettore(6)
TextO7 = vettore(7)
' riga 4
TextC4 = TextO1
TextD4 = TextO2
TextF4 = TextO3
TextI4 = TextO2
TextJ4 = TextO4

' riga 7
TextC7 = TextO1
TextD7 = TextO4
TextF7 = TextO4
TextJ7 = TextO5

'riga10
TextD10 = TextO4
TextF10 = TextO6
TextJ10 = TextO7

' verifica


' riga 14
TextD14 = TextC4 & TextD4
TextF14 = TextF4
TextH14 = TextI4 & TextJ4
If CInt(TextD14) * (CInt(TextF14) - CInt(TextH14)) = 0 Then TextJ14 = "VERO": value = value + 1 Else TextJ14 = "FALSO"

' riga 15
TextD15 = TextC7 & TextD7
TextF15 = TextF7
TextH15 = TextJ7
If CInt(TextD15) - (CInt(TextF15) * CInt(TextH15)) = 0 Then TextJ15 = "VERO": value = value + 1 Else TextJ15 = "FALSO"

' riga 16
TextD16 = TextD10
TextF16 = TextF10
TextH16 = TextJ10
If CInt(TextD16) + CInt(TextF16) - CInt(TextH16) = 0 Then TextJ16 = "VERO": value = value + 1 Else TextJ16 = "FALSO"

' riga 17
TextD17 = TextC4 & TextD4
TextF17 = TextD7
TextH17 = TextD10
If CInt(TextD17) - CInt(TextF17) - CInt(TextH17) = 0 Then TextJ17 = "VERO": value = value + 1 Else TextJ17 = "FALSO"

' riga 18
TextD18 = TextF4
TextF18 = TextF7
TextH18 = TextF10
If CInt(TextD18) + CInt(TextF18) - CInt(TextH18) = 0 Then TextJ18 = "VERO": value = value + 1 Else TextJ18 = "FALSO"

' riga 19
TextD19 = TextI4 & TextJ4
TextF19 = TextJ7
TextH19 = TextJ10
If CInt(TextD19) - (CInt(TextF19) * CInt(TextH19)) = 0 Then TextJ19 = "VERO": value = value + 1 Else TextJ19 = "FALSO"

' riga 20
TextJ20 = value

If TextJ20 = 6 Then
risultato = True
Else
risultato = False
End If

DoEvents ' per vedere la progressione

End Function

non riesco a capire l'inghippo del programma, poichè intanto non mi fa vedere la progressione dei numeri sui textbox text01 text02 text03 ecc.ecc. e poi non effettua nemmeno il corretto calcolo come faceva per il calcolo enigmatico a 5 numeri.

se qualcuno a qualche bella idea??? sarebbe utile per la mia mente che sta andando in fumo...
Ultima modifica effettuata da maurizio74 12/03 11:12
aaa
12/03 16:01
Carlo
Hai fatto solo errori di trascrizione, riguarda bene, metti le righe e le colonne per identificare le textbox.

La riga: TextF17 = TextD7 è incompleta, dopo l'uguale ci vanno due textbox nel giusto ordine

In allegato l'eseguibile funzionante.

Se togli DoEvents non vedi la progressione ma le permutazioni avvengono più velocemente.
in programmazione tutto è permesso
12/03 18:00
maurizio74
Ciao Carlo sempre gentilissimo,

effettivamente avevo distrattamente saltato textC7
nella riga 17 TextF17 = textC7 & TextD7 pero' da me non funziona ugualmente
non capisco perchè'? poi come puoi vedere non avevo tolto il DoEvents come mai oltre al calcolo errato non vedo la progressione???

ti allego il progetto se daresti un occhiata??'

grazieeeeee....
Ultima modifica effettuata da maurizio74 14/03 9:53
aaa
12/03 19:06
Carlo
1) Text01 e TextO1, non è la stessa cosa... nel form hai le textbox con lo zero al posto della O

2) caricare due volte le Text è inutile:
TextO1 = vettore(1)
TextO2 = vettore(2)
TextO3 = vettore(3)
TextO4 = vettore(4)
TextO5 = vettore(5)
TextO6 = vettore(6)
TextO7 = vettore(7)
        
TextO1 = vettore(1)
TextO2 = vettore(2)
TextO3 = vettore(3)
TextO4 = vettore(4)
TextO5 = vettore(5)
TextO6 = vettore(6)
TextO7 = vettore(7)


questa riga è sbagliata:
If CInt(TextD14) * (CInt(TextF14) - CInt(TextH14)) = 0 Then TextJ14 = "VERO": value = value + 1 Else TextJ14 = "FALSO"


Si vuole verificare se il valore in TextD14 moltiplicato il valore in TextF14 da come risultato il valore presente in TextH14
es: 10x2=20?
La tua riga fa: se (2-20) moltiplicato 10 da zero il calcolo è esatto... (SBAGLIATO)

Invece devi fare se 10x2 meno 20 da zero il calcolo è esatto!!! (ESATTO)

Il resto è tutto corretto, bravo ma non sufficientemente attento, la programmazione non ammette errori :k:

Ultima modifica effettuata da Carlo 12/03 20:18
in programmazione tutto è permesso
12/03 20:21
maurizio74
Ciao Carlo,

grazie per la veloce risposta, non so' che dirti, hai ragione, ovviamente lo so che, Text=01 e TextO1, non sono la stessa cosa forse sara' l'unica cosa di cui ne so certo.... come sono certo che ho fatto parecchi errori di trascrizione infatti avevo fatto dei copia incolla per fare piu' veloce tra il mio programma ed alcune parti del code che mi avevi postato, poi potrei aggiungere che sono un po' cieco, da questo miscuglio e nato tutto l'inghippo.:hail::hail::hail: Adesso a mente fredda e distaccata e con le tue evidenziazioni ho sistemato tutto... pero' anche questo mi servira' per il futuro...
grazie ancora:k::k::k::k:

alla prossima...

Buon Lavoro...:k::k:
aaa