Lösungen der VBA-Übungsaufgaben

[noir]

hat jemand die lösungen von den übungen?

[xanthos]

Eine mustergültige Lösung mit viel viel Text.

----
Sub main()

Dim z1 As Integer 'Eingabewerte
Dim z2 As Integer

Dim p As Integer 'Variablen zum Rechnen
Dim q As Integer
Dim r As Integer

Dim Title As String 'Zeichenkette

Title = "Euklid'scher Algorithmus"
'Zeichenketten werden in Anführungszeichen (") eingefasst

z1 = InputBox("Zahl z1 > 0 eingeben", Title)
z2 = InputBox("Zahl z2 > 0 eingeben", Title)

If (z1 > 0) And (z2 > 0) Then

  p = z1
  q = z2
 
  Debug.Print 'gibt eine Leerzeile aus
  Debug.Print "Gleich geht der Zyklus los!"
 
  Do
    r = p Mod q
   
    Debug.Print "p ="; p, "q ="; q, "r ="; r
    'Print schreibt nach dem Semikolon ( unmittelbar weiter
    'Mit dem Komma (,) lassen sich Werte spaltenweise ausgeben
   
    If r = 0 Then Exit Do
    p = q
    q = r
  Loop
 
  Debug.Print "Das war's schon!"
  MsgBox "Ergebnis ggT(" + Str(z1) + "," + Str(z2) + ") = " + Str(q), , Title
 
Else
 
  MsgBox "Wertebereich beachten!", , Title

End If

End Sub

[xanthos]

Bei der Steuerung der Schrittweite komme ich nicht wirklich weiter.
Schließlich soll das Programm keine Endlosschleife werden.
Vielleicht kann mir jemand die zündende Idee liefern?

Option Explicit

----------------------------------------------------------------------------

Function Rundung(z As Double) As Double
  Dim Faktor As Double
  Faktor = 10 ^ 3 'Rundung auf 3 Dezimalstellen
  Rundung = Int(Faktor * z + 0.5) / Faktor
End Function

----------------------------------------------------------------------------

Function Kruemmung(x As Double) As Double
  Dim y1 As Double '1. Ableitung
  Dim y2 As Double '2. Ableitung
  y1 = 2 * x
  y2 = 2
  Kruemmung = y2 / (1 + y1 * y1) * 1 / Sqr(1 + y1 * y1)
End Function

----------------------------------------------------------------------------

Sub main()

Dim x_start As Double 'Eingabewerte
Dim x_end As Double
Dim x_step As Double

Dim x As Double 'Variablen zum Rechnen
Dim y As Double

Dim k As Double 'Krümmung an der Stelle x
Dim k1 As Double 'Krümmung für x - x_step/2
Dim k2 As Double 'Krümmung für x + x_step/2

Dim z As Integer 'Nummer des Punktes

Dim Title As String
Dim Line As String

Title = "Parabel"
Line = String$(10, "-") 'erzeugt eine Zeichenkette mit 10 Minuszeichen

x_start = InputBox("Eingabe x_start", Title, -2)
x_end = InputBox("Eingabe x_end", Title, 2)
x_step = InputBox("Eingabe x_step <> 0", Title, 0.25)

'Vorzeichen der eingegebenen Schrittweite prüfen
'ggf. wird das Vorzeichen invertiert
If x_start < x_end Then
  If x_step < 0 Then x_step = -x_step
Else
  If x_step > 0 Then x_step = -x_step
End If

If x_step = 0 Then
  MsgBox "Problem: Schrittweite ist Null!", , Title
  Exit Sub '... und Tschüß!
End If

x = x_start 'Auf die Plätze, fertig, ...
z = 1

'Ausgabe als Wertetabelle im Direktbereich
Debug.Print
Debug.Print " z", " x", " y", " k", " delta"
Debug.Print Line, Line, Line, Line, Line

Do While x <= x_end
 
  y = x ^ 2
 
  k = Kruemmung(x)
  k1 = Kruemmung(x - x_step / 2)
  k2 = Kruemmung(x + x_step / 2)
 
  Debug.Print z, x, y, Rundung(k), Rundung(Abs(k1 - k2))
 
  'Steuerung der Schrittweite
  'Hier sollte auch die Krümmung einfließen, aber wie
 
  x = x + x_step
  z = z + 1
 
Loop

Debug.Print Line, Line, Line, Line, Line

End Sub