Springen naar inhoud


- - - - -
VB6

Een Getal Reduceren Met Uitzondering



  • Log in a.u.b. om te beantwoorden
Er zijn 13 reacties in dit onderwerp

#1 houthalen

houthalen

    Senior Developer

  • Leden
  • PipPipPip
  • 167 berichten
    Laatst bezocht 05 jan 2020 16:47

Geplaatst op 08 mei 2015 - 11:37

Dag
ik heb een klein probleem maar ik raak niet uit
Met deze klein routine reduceer ik een getal tot max 9 in text1.text ingevoerd.

Code:
Private Sub Text1_Change()
Dim i As Integer, nummer As String, som As Long
nummer = text1.text
Do
	som = 0
	For i = 1 To Len(nummer)
	som = som + Val(Mid(nummer, i, 1))
	Next
	nummer = som
Loop Until som <= 9
Label1.Caption = som
End Sub



BV
text1.text="1234"
dan word  1+2+3+4 =10
en dan nogmals 1+0=1
dus reduceer tot resultaat <=9 is
en dit werkt goed.



ik wou nu een utzondering plaatsen:
Als in de loop van de reductie de nummer 11 word dan moet zo blijven, niet meer gereduceerd tot 2 (1+1)
ik heb geprobeerd met
Loop Until som <= 9 and <>11 maar het werkt niet.
hoe moet ik veranderen?
dank u


#2 tromt

tromt

    Professional Developer

  • Leden
  • PipPipPipPip
  • 303 berichten
    Laatst bezocht 17 apr 2018 10:02
  • LocatieRijen (NB)

Geplaatst op 10 mei 2015 - 11:13

Loop Until (som <= 9 or som = 11)

#3 houthalen

houthalen

    Senior Developer

  • Leden
  • PipPipPip
  • 167 berichten
    Laatst bezocht 05 jan 2020 16:47

Geplaatst op 11 mei 2015 - 15:07

Dag Tromt.
Ik had al zo geprobeerd maar toch wordt 11 nog steeds gereduceerd tot 2.
Ik weet echt niet waarom.

Citeren

Loop Until (som <= 9 or som = 11)
zou moeten werken.
Ik heb getest maar 11 wordt nog 2

#4 Dirk Andries

Dirk Andries

    Guru Developer

  • Leden
  • PipPipPipPipPipPip
  • 1189 berichten
    Laatst bezocht
  • LocatieGent

Geplaatst op 12 mei 2015 - 08:43

Bericht bekijkenhouthalen, op 11 mei 2015 - 15:07, zei:

Dag Tromt.
Ik had al zo geprobeerd maar toch wordt 11 nog steeds gereduceerd tot 2.
Ik weet echt niet waarom.


zou moeten werken.
Ik heb getest maar 11 wordt nog 2
Dat is omdat je altijd het reduceren minstens 1 maal uitvoert voordat je de voorwaarde test.
Dat is eigen aan een Do ... Loop Until of een Do ... Loop While

Met "29" zal het dus wel werken.
Met "11" werkt het niet want dat wordt eerst gereduceerd tot 2 en pas dan volgt de test.

Oplossing: eerst testen, pas dan reduceren (indien nog nodig).

#5 houthalen

houthalen

    Senior Developer

  • Leden
  • PipPipPip
  • 167 berichten
    Laatst bezocht 05 jan 2020 16:47

Geplaatst op 12 mei 2015 - 12:59

ja, Dirk, het zit inderdaad zo;
probleem is waar eerste testen en dan pas reduceren.

Il heb
Code:
Loop Until (som <= 9 or som = 11)
geprobeerd te verplaatsen in ander 'positie' in de code
maar nog steeds niet gelukt.
Ik zal nog eens proberen de juiste'positie' te vinden.

dank u
houthalen

#6 Dirk Andries

Dirk Andries

    Guru Developer

  • Leden
  • PipPipPipPipPipPip
  • 1189 berichten
    Laatst bezocht
  • LocatieGent

Geplaatst op 13 mei 2015 - 08:54

Bericht bekijkenhouthalen, op 12 mei 2015 - 12:59, zei:

ja, Dirk, het zit inderdaad zo;
probleem is waar eerste testen en dan pas reduceren.

Il heb
Code:
Loop Until (som <= 9 or som = 11)
geprobeerd te verplaatsen in ander 'positie' in de code
maar nog steeds niet gelukt.
Ik zal nog eens proberen de juiste'positie' te vinden.

Je moet de Do ... Loop Until niet verplaatsen.
Je kiest ofwel
a.  een ander soort loop (één die eerst test en pas dan uitvoert): Do Until ... Loop, of Do While ... Loop, of While...End While
b. je laat de loop zoals ze is, maar je doet een (extra) test in de loop vóór het reduceren
c. je laat de loop zoals ze is doet de test vóór de loop

Voorbeeld voor a.
Visual Basic Code:

Private Sub Text1_Change()

	 Dim i As Integer, nummer As String, som As Long
	 nummer = Text1.Text
	 som = Val(nummer)
	 Do Until som < 10 Or som = 11
		 som = 0
		 For i = 1 To Len(nummer)
			 som = som + Val(Mid(nummer, i, 1))
		 Next
		 nummer = som
	 Loop
	 Label1.Caption = nummer
End Sub



#7 houthalen

houthalen

    Senior Developer

  • Leden
  • PipPipPip
  • 167 berichten
    Laatst bezocht 05 jan 2020 16:47

Geplaatst op 14 mei 2015 - 08:34

Uw voorbeeld code (a), beste Dirk, werkte maar ook niet altijd.
Ik heb intussen anders aangepaakt en, volgens vele tests , werkt nu wel.
Ik moest wel onder een commandbutton plaatsen ,want met text1.change werkt niet
en een ander aanpak.
Hier mijn nieuw, werkende,  formule
Code:
Private Sub Command1_Click()
On Error Resume Next
Dim TxtGetal As String
Dim T As Integer
Dim tmpsom As Integer
If IsNumeric(txtsom) Then TxtGetal = txtsom
If TxtGetal > 9 Then
While TxtGetal > 9 And TxtGetal <> 11
	 For T = 1 To Len(TxtGetal)
		 tmpsom = tmpsom + Val(Mid(TxtGetal, T, 1))
	 Next
	 TxtGetal = tmpsom
	 tmpsom = 0
Wend
End If
label1.Caption = TxtGetal
End sub

het is dus, zo te zien, opgelost.
Toch bedankt voor de inzet.
dank u
houthalen

#8 Dirk Andries

Dirk Andries

    Guru Developer

  • Leden
  • PipPipPipPipPipPip
  • 1189 berichten
    Laatst bezocht
  • LocatieGent

Geplaatst op 14 mei 2015 - 12:12

Bericht bekijkenhouthalen, op 14 mei 2015 - 08:34, zei:

Uw voorbeeld code (a), beste Dirk, werkte maar ook niet altijd.
Dat is mogelijk, want ik heb geen vb classic en heb ook geen kennis van vb classic (enkel van .net).
Dus dat was uit het hoofd (en gegokt naar de vb classic syntax).

Maar ik ben wel nieuwsgierig: wanneer werkte het niet, dan?
En wat is dan "niet werken"?

#9 houthalen

houthalen

    Senior Developer

  • Leden
  • PipPipPip
  • 167 berichten
    Laatst bezocht 05 jan 2020 16:47

Geplaatst op 14 mei 2015 - 15:35

Het is moelijk te zeggen wanneer niet werkt en wanneer wel.
Bv:
Na grote berekeningen, vanaf groot getallen werkte, (12422) ook als niet altijd.

Maar beginnend bij kleine getallan als input (28, 29, 74...) dan blijft de routine reduceren tot 2.

Natuurlijk de routine is enkel een deel van een grotere programma .

Met mijn laatste code werkte, volgens mijn test, altijd.

Ik had soms wel een toevallig error , ik weet niet meer welke,
en daarom, zoals je ziet, aan het begin van de routine moest ik een
Code:
On Error Resume Next
plaatsen.
Het niet fijn of professioneel, het is ook dus mijn code niet perfect, maar het deed wat moest doen, namelijk
reduceren tot 9 met uitzondering van 11.

Nogmaals bedankt
houthalen

#10 Dirk Andries

Dirk Andries

    Guru Developer

  • Leden
  • PipPipPipPipPipPip
  • 1189 berichten
    Laatst bezocht
  • LocatieGent

Geplaatst op 14 mei 2015 - 19:43

Bericht bekijkenhouthalen, op 14 mei 2015 - 15:35, zei:

Het is moelijk te zeggen wanneer niet werkt en wanneer wel.
Bv:
Na grote berekeningen, vanaf groot getallen werkte, (12422) ook als niet altijd.

Maar beginnend bij kleine getallan als input (28, 29, 74...) dan blijft de routine reduceren tot 2.
Bij mij werkt dat dus gewoon goed (maar dat is dus vb.net).
Ik blijf dus nieuwsgierig naar de gevallen waar het niet goed werkte (en de verklaring).

Bijlage  reduce29.png   19,08K   3 downloads
Bijlage  reduce11.png   4,46K   3 downloads
Bijlage  reduce72.png   5,39K   0 downloads
Bijlage  reduce74.png   5,2K   0 downloads

#11 houthalen

houthalen

    Senior Developer

  • Leden
  • PipPipPip
  • 167 berichten
    Laatst bezocht 05 jan 2020 16:47

Geplaatst op 14 mei 2015 - 20:32

Ja, ik heb gezien dat bij u werkt , Dirk.
Normaal gezien zou moeten werken ook bij mij met vb6


ps. Ik heb gezien dus dat je werkt met Vb Net. Prachtig.
Ik heb ook een paar boeken (over vb Net) staan en zou ook willen
daar aan beginnen.

Feit is dat Ik programmeren nu niet veel. Ik ben alleen bezig met oudere programma te aanpassen.

Wie weet , begin ik ook met vb net.
Zo een grote verschil  met vb6 zal niet zijn.

Ik zal zien
Bedankt voor de moeite

houthalen

#12 Lunatic

Lunatic

    Senior Developer

  • Leden
  • PipPipPip
  • 122 berichten
    Laatst bezocht 20 feb 2019 18:30
  • LocatieGent

Geplaatst op 17 mei 2015 - 15:39

En zo?

Visual Basic Code:
Private Sub Text1_Change()

Dim i As Integer, nummer As String, som As Long

nummer = text1.text
Do
   If Val(nummer) = 11 Then Exit Do
   som = 0
   For i = 1 To Len(nummer)
	  som = som + Val(Mid(nummer, i, 1))
   Next
   nummer = som
Loop Until som <= 9
Label1.Caption = som

End Sub



#13 Dirk Andries

Dirk Andries

    Guru Developer

  • Leden
  • PipPipPipPipPipPip
  • 1189 berichten
    Laatst bezocht
  • LocatieGent

Geplaatst op 18 mei 2015 - 13:34

Bericht bekijkenLunatic, op 17 mei 2015 - 15:39, zei:

En zo?

Visual Basic Code:
Private Sub Text1_Change()

Dim i As Integer, nummer As String, som As Long

nummer = text1.text
Do
If Val(nummer) = 11 Then Exit Do
som = 0
For i = 1 To Len(nummer)
som = som + Val(Mid(nummer, i, 1))
Next
nummer = som
Loop Until som <= 9
Label1.Caption = som

End Sub


Dat is b. uit deze post.
Heeft dus ook het nadeel dat het reduceren ook (overbodig) gebeurt bij som < 10.
En dat je twee testen hebt i.p.v. één.
Dus a. is hier beter, denk ik.

#14 houthalen

houthalen

    Senior Developer

  • Leden
  • PipPipPip
  • 167 berichten
    Laatst bezocht 05 jan 2020 16:47

Geplaatst op 25 mei 2015 - 19:08

Nee dus, Lunatic.
Het blijft reduceren <10
Ik blijf bij mijn aangepast oplossing (en geen text change maar alles onder een commbutton)
Code:
[list=1]
	[*]Private Sub Command1_Click()
	[*]On Error Resume Next
	[*]Dim T As Integer
	[*]Dim tmpsom As Integer
	[*]If IsNumeric(txtsom) Then TxtGetal = txtsom
	[*]If TxtGetal > 9 Then
	[*]Dim TxtGetal As String
	[*]While TxtGetal > 9 And TxtGetal <> 11
	[*]	 For T = 1 To Len(TxtGetal)
	[*]		 tmpsom = tmpsom + Val(Mid(TxtGetal, T, 1))
	[*]	 Next
	[*]	 TxtGetal = tmpsom
	[*]	 tmpsom = 0
	[*]Wend
	[*]End If
	[*]label1.Caption = TxtGetal
	[*]End sub
[/list]


(ook als het blijft een mysterie dat bij Dirk werkt in vb.net en in vb6 niet).
nogmaals bedankt oor jullie inzet.
Ik doe verder met mijn oplossing.
dank u
houthalen





Ook met taq VB6 voorzien

0 gebruiker(s) lezen dit onderwerp

0 lid(leden), 0 bezoeker(s), 0 anonieme gebruikers

Inloggen


[VB6] Untitled 1

Met dank aan Jürgen voor de jarenlange inzet van visualbasic.be (anno dec 2000)
Met dank aan Mike en Ronneke voor de jarenlange inzet van vbib.be (anno dec 2010)
Met dank aan PascalBianca voor de jarenlange inzet van vbib.be (anno dec 2016)