|
Sub SpiegelX()
Dim eingabeZ As Byte
Dim eingabeS
Dim zeile As Byte
Dim spalte As Byte
Dim d As Byte
eingabeZ = InputBox("Zeilenanzahl?")
eingabeS = InputBox("Spaltenanzahl?")
d = eingabeS * 2
Do
zeile = zeile + 1
For spalte = 1 To eingabeS
ActiveWorkbook.Worksheets(1).Cells(zeile, d) = ActiveWorkbook.Worksheets(1).Cells(zeile, spalte)
d = d - 1
Next spalte
d = eingabeS * 2
spalte = 1
Loop Until zeile = eingabeZ
End Sub
Sub SpiegelY()
Dim eingabeZ As Byte
Dim eingabeS As Byte
Dim zeile As Byte
Dim spalte As Byte
Dim a As Byte
eingabeZ = InputBox("Zeilenanzahl?")
eingabeS = InputBox("Spaltenanzahl?")
a = eingabeZ * 2
Do
zeile = zeile + 1
For spalte = 1 To eingabeS
ActiveWorkbook.Worksheets(1).Cells(a, spalte) = ActiveWorkbook.Worksheets(1).Cells(zeile, spalte)
Next spalte
a = a - 1
spalte = 1
Loop Until zeile = eingabeZ
End Sub
Sub Matrix()
Dim zeile As Byte
Dim spalte As Byte
Dim Eingabe As Byte
Eingabe = InputBox("wie groß?")
Do
zeile = zeile + 1
For spalte = 1 To Eingabe
ActiveWorkbook.Worksheets(1).Cells(zeile, spalte) = spalte * zeile
Next spalte
spalte = 1
Loop Until zeile = Eingabe
End Sub
Sub Matrix2()
Dim zeile As Byte
Dim spalte As Byte
Dim Eingabe As Byte
Eingabe = InputBox("wie groß?")
Do
zeile = zeile + 1
For spalte = 1 To Eingabe
ActiveWorkbook.Worksheets(1).Cells(zeile, spalte) = spalte & "." & zeile
Next spalte
spalte = 1
Loop Until zeile = Eingabe
End Sub
Sub Matrix3()
Dim Bereich As Range, Zelle As Range
Set Bereich = Selection
For Each Zelle In Bereich
Zelle.Value = Zelle.Address
Next Zelle
End Sub
Function Primzahl(Zahl As Integer) As Boolean
Dim a As Double
Dim b As Double
Dim i As Integer
If Zahl = 1 Then
MsgBox ("1 ist keine Primzahl")
Else
For i = 1 To Zahl
a = Zahl / i
If a = Int(a) Then
b = b + 1
End If
Next
End If
If b > 2 Then
Primzahl = False
Else
Primzahl = True
End If
End Function
Sub Quersumme()
Dim i As Long
Dim ergebnis As Integer
Dim Eingabe As String
Eingabe = InputBox("Von welcher Zahl wollen Sie die Quersumme wissen?", "Quersumme bilden")
If IsNumeric(Eingabe) = False Then Exit Sub
For i = 1 To Len(Eingabe)
ergebnis = ergebnis + CInt(Mid(Eingabe, i, 1))
Next
MsgBox "Quersumme von " & Eingabe & " ist: " & ergebnis
End Sub
Sub SchnikSchnakSchnuck()
Dim Eingabe As String
Dim Zufall As Byte
Dim Computer As String
Dim Spieler1 As Byte
Dim Ausgabe As String
Eingabe = InputBox("Schere(1)...Stein(2)...Papier(3)! Geben sie die passende Zahl ein!", "SchnickSchnackSchnuck")
Zufall = Int((3) * Rnd + 1)
Select Case Zufall
Case 1
Computer = "Schere"
Case 2
Computer = "Stein"
Case Else
Computer = "Papier"
End Select
If Spieler1 = 1 Then
If Zufall = 1 Then
Ausgabe = Eingabe & " Unentschieden " & Computer
ElseIf Zufall = 2 Then
Ausgabe = Eingabe & " Verloren " & Computer
Else
Ausgabe = Eingabe & " Gewonnen " & Computer
End If
ElseIf Spieler1 = 2 Then
If Zufall = 2 Then
Ausgabe = Eingabe & " Unentschieden " & Computer
ElseIf Zufall = 3 Then
Ausgabe = Eingabe & " Verloren " & Computer
Else
Ausgabe = Eingabe & " Gewonnen " & Computer
End If
Else
If Zufall = 3 Then
Ausgabe = Eingabe & " Unentschieden " & Computer
ElseIf Zufall = 1 Then
Ausgabe = Eingabe & " Verloren " & Computer
Else
Ausgabe = Eingabe & " Gewonnen " & Computer
End If
End If
MsgBox Ausgabe
End Sub
Function Rechteck(seiteA As Double, seiteB As Double) As Boolean
Dim Fläche As Double
Dim Umfang As Double
Fläche = seiteA * seiteB
Umfang = (seiteA * 2) + (seiteB * 2)
If Fläche > Umfang Then
Rechteck = True
End If
End Function
Function grösste(x As Double, y As Double, z As Double) As Double
'If x >= y And x >= z Then
'grösste = x
'ElseIf y >= x And y >= z Then
'grösste = y
'ElseIf z >= x And z >= y Then
'grösste = z
'Else
'End If
grösste = WorksheetFunction.Max(x, y, z)
End Function
Sub BereichMultiplizieren()
Dim Bereich As Range
Dim Zelle As Range
Dim Faktor As Double
Faktor = 1.1
Set Bereich = Selection
For Each Zelle In Bereich
If IsNumeric(Zelle.Value) Then
Zelle.Value = Zelle.Value * Faktor
End If
Next Zelle
End Sub
|