top of page
Boys at School

Werden Sie ein Teil von Lehrer - Alltag

ChatGPT erstelle mir bitte einen VBA-Code für EXCEL



Schreibe ein VBA Makro für Excel 363, dass eine 20x20 Tabelle im aktiven Tabellenblatt erstellt. In diese Matrix sollen 5 Begriffe mit maximal 5 Zeichen Länge zum Thema Datenbanken entweder in Zeilen oder in Spalten eingetragen werden. Dabei steht in jeder Zelle nur ein roter Buchstabe. Zellen, die belegt sind, dürfen nicht überschrieben werden. Bevor ein Begriff eingetragen wird, prüfe, ob ausreichend freie Zellen vorhanden sind. Wenn nicht, suche eine andere Startposition. Die Begriffe sind vollständig und ohne Unterbrechung einzutragen. Fülle zum Schluss alle leeren Zellen mit zufälligen kleinen Buchstaben

Please write in German language.
 

Nun hat die KI die Eigenart, nicht immer das gleiche Ergebnis zu produzieren. Es kann also durchaus passieren, dass nicht jeder Code von Anfang an läuft. Allerdings hilft die KI dann, die Fehler zu korrigieren. Man muss "sie" halt fragen.


Wie lautet das Ergebnis?



Sub Datenbanken()
Dim maxVersuche As Integer
Dim versucheZaehler As Integer
Dim zeilenIndex As Integer
Dim spaltenIndex As Integer
Dim richtung As Integer
Dim wortIndex As Integer
Dim aktuellesWort As String
Dim aktuellesZeichen As String
Dim anzahlZeichen As Integer
Dim anzahlFreieZellen As Integer
Dim freieZelleGefunden As Boolean
'Die Wörter, die in der Tabelle platziert werden sollen
Dim woerter() As String
woerter = Split("SQL, Key, Access, Codd, ERD, Relation, Insert, Tabelle, Spalte, Zeile, Index, Normalisierung, Gruppierung", ",")
'Maximale Anzahl an Versuchen, um eine freie Zelle zu finden
maxVersuche = 30
'Durchlaufe jedes Wort, das in der Tabelle platziert werden soll
For wortIndex = 0 To UBound(woerter)
aktuellesWort = woerter(wortIndex)
anzahlZeichen = Len(aktuellesWort)
freieZelleGefunden = False
versucheZaehler = 0
Columns("A:R").ColumnWidth = 3
'Schleife, bis eine freie Zelle gefunden wird oder die maximale Anzahl an Versuchen erreicht wurde
Do While Not freieZelleGefunden And versucheZaehler < maxVersuche
'Wähle zufällig eine Start-Zeilen- und Spalten-Position
zeilenIndex = Int(Rnd() * (18 - anzahlZeichen + 1)) + 1
spaltenIndex = Int(Rnd() * (18 - anzahlZeichen + 1)) + 1
'Wähle zufällig eine Richtung, in die das Wort platziert werden soll (0 = horizontal, 1 = vertikal)
richtung = Int(Rnd() * 2)
'Prüfe, ob die ausgewählte Startzelle im Bereich A1:R20 liegt
If zeilenIndex >= 1 And zeilenIndex <= 20 And spaltenIndex >= 1 And spaltenIndex <= 20 Then
'Prüfe, ob genug freie Zellen vorhanden sind, um das Wort in der ausgewählten Richtung zu platzieren
anzahlFreieZellen = 0
For i = 0 To anzahlZeichen - 1
If richtung = 0 Then 'horizontal
If Cells(zeilenIndex, spaltenIndex + i).Value = "" Then
anzahlFreieZellen = anzahlFreieZellen + 1
End If
Else 'vertikal
If Cells(zeilenIndex + i, spaltenIndex).Value = "" Then
anzahlFreieZellen = anzahlFreieZellen + 1
End If
End If
Next i
'Wenn genug freie Zellen vorhanden sind, platziere das Wort in der ausgewählten Richtung
If anzahlFreieZellen = anzahlZeichen Then
freieZelleGefunden = True
For i = 0 To anzahlZeichen - 1
aktuellesZeichen = Mid(aktuellesWort, i + 1, 1)
If richtung = 0 Then 'horizontal
Cells(zeilenIndex, spaltenIndex + i).Value = aktuellesZeichen
Else 'vertikal
Cells(zeilenIndex + i, spaltenIndex).Value = aktuellesZeichen
End If
Next i
Else 'Andernfalls erhöhe den Versuchs-Zähler und versuche es erneut
versucheZaehler = versucheZaehler + 1
End If
End If
Loop
'Wenn keine freie Zelle gefunden wurde, zeige eine Fehlermeldung an und verlasse die Schleife
If Not freieZelleGefunden Then
MsgBox "Das Wort " & aktuellesWort & " konnte nach " & maxVersuche & " Versuchen nicht platziert werden."
Exit For
End If
Next wortIndex
Columns("A:R").ColumnWidth = 3
'Fülle alle übrigen leeren Zellen mit zufälligen Buchstaben
Range("A1:R20").Select 'Wähle den Bereich der Tabelle aus
For Each zelle In Selection
If zelle.Value = "" Then
zelle.Value = Chr(Int((122 - 97 + 1) * Rnd() + 97)) 'Kleinbuchstabe
zelle.Font.Color = RGB(255, 0, 0) 'rot
End If
Next zelle
'Fülle alle übrigen leeren Zellen mit zufälligen roten Buchstaben
Range("A1:R20").Select 'Wähle den Bereich der Tabelle aus
For Each zelle In Selection
If zelle.Value = " " Then
zelle.Value = Chr(Int((122 - 97 + 1) * Rnd() + 97)) 'Kleinbuchstabe
zelle.Font.Color = RGB(255, 0, 0) 'rot
End If
Next zelle
End Sub

Sie können versuchen, sich den Code selbst zu produzieren mittel KI oder aber, meine Empfehlung, Sie nehmen den obigen Quellcode für das VBA Makro und ändern nur diese Zeile mit eigenen Wörtern ab. Übertreiben Sie die Anzahl nicht, dann kommt ggf. eine Fehlermeldung und Sie müssen das Makro neu starten.


woerter = Split("SQL, Key, Access, Codd, ERD, Relation, Insert, Tabelle, Spalte, Zeile, Index, Normalisierung, Gruppierung", ",")

Ebenso sollten Sie diese Zeile (Korrekturmodus) anpassen:


zelle.Font.Color = RGB(255, 0, 0) 'rot

durch diese ersetzen:


zelle.Font.Color = RGB(0, 0, 0) 'schwarz


gitter
.txt
TXT herunterladen • 3KB
















94 Ansichten0 Kommentare

Aktuelle Beiträge

Alle ansehen

Comments

Rated 0 out of 5 stars.
No ratings yet

Add a rating
bottom of page