Zeilen automatisch ausfüllen
20.06.2021 23:16:11
Marko_B085
Bisher war ich immer ein stiller Zuhörer und die Beiträge hier haben mir sehr oft weitergeholfen. jetzt bin ich aber auf ein Problem gestoßen, was mich zum Grübeln bringt.
Ich habe ein Programm geschrieben, das mit einem Mausklick eine eine Zelle (z.b. n2) einen Kreis in die geklickte Zellen (N2) setzt. Diese Kreis kann zufällig von Nutzer gesetzt werden, d.h. die Setzung der Kreise folgt keiner Reihenfolge. Das habe ich soweit hinbekommen. Nun soll aber mit jedem neuen Kreis die Nummer erhöht werden, d.h. bspw. Der zweite gesetzte Kreis soll einen counter von 2 haben und dieser soll nach und nach in eine Spalte eingetragen werden. Dabei soll mit jedem neuen Kreis die Spalte automatisch nach unten gehen. So soll also bei ersten Kreis die Nr. 1 in A1, beim zweiten Kreis die Nr. 2 in A2 usw. Automatisch eingetragen werden.
Gleichzeitig soll in einer weiteren Spalte, abhängig vom Bereich in dem der Kreis gesetzt wurde, der jeweilige Bereich aufgenommen werden. Wurde ein Bereich aufgenommen so soll der Bereich in der Spalte angezeigt werden. Wird aber ein Kreis nochmal im gleichen Bereich aufgenommen wird die Spalte leer gelassen. Erst wenn ein Kreis in einem neuen Bereich gesetzt wird, wird der Bereich wieder aufgenommen.
Insgesamt soll es wie folgt Aussehen:
Ich habe bereits einen Versuch gestartet (siehe Quellcode) aber es tut sich leider nicht.
Ich hoffe ihr könnt mir bei meinem Problem weiterhelfen. Schon viele vielen Dank im vorraus.
Eine zusätzliche Frage. Damit sich mein Code aktiviere, muss ich in dem Makro jede Zeile einzeln eintragen, die angeklickt werden kann. Ist es auch möglich dies kürzer zu fassen, so dass ich im Makro statt für jeder einzelnen Zeile auch für jeden bereich schreibe kann. Dabei soll weiterhin durch Anklicken auf jeder Zelle eines Bereichs das Makro durchgeführt werden.
Hier mal ein Ausschnitt aus meinen code. DIeser Ausschnitt betrift die Eingaben für eine Zelle.
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Static counter As Integer
counter = 1 + counter
If Target.Address = "$A$1" Then
Add_Shape_At_Cursor_Position
Cancel = True
If Target.Address = "$A$1" Then
If i = Range("A1:A100").Find("").Row Then
i = Range("A" & i).Value = "Linker Flügel"
Else
i = i + 1
i = Range("A" & i).Value = "Linker Flügel"
End If
If x = Range("B1:DB100").Find("").Row Then
x = Range("B" & x).Value = counter
Else
x = x + 1
x = Range("A" & x).Value = counter
End If
End If
If Target.Address "$B$10" Then Exit Sub
Add_Shape_At_Cursor_Position
Cancel = True
End If
End Sub