Office: WENN Makro

Helfe beim Thema WENN Makro in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo liebes Forum, ich versuche über meine WENN Abfrage ein Makro (eine Funktion) zu starten =WENN(H2"";ellipse();"") Meine extra-komplizierte... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von falko_d, 25. Oktober 2020.

Seite 1 von 3

FALKO_D

falko_d

WENN Makro

Hallo liebes Forum,

ich versuche über meine WENN Abfrage ein Makro (eine Funktion) zu starten
=WENN(H2"";ellipse();"")

Meine extra-komplizierte Funktion, die aufgerufen werden soll:

Code:

Function ellipse()

ellipse_woanders_einfügen

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

und der Code, der daraufhin einen hübschen Kringel um 5 Spalten nach links versetzt einfügen soll:

Code:

Sub ellipse_woanders_einfügen()
Dim Länge%, Höhe%, ellipse
Länge = 14
Höhe = 14
Value = 5
Selection.Offset(0, -Value).Select
Set ellipse = ActiveSheet.Shapes.AddShape(msoShapeOval, ActiveCell.Left - Länge / 2, ActiveCell.Top + (ActiveCell.Height - Höhe) / 2, Länge, Höhe)
ellipse.Fill.Visible = msoTrue
ellipse.Fill.ForeColor.RGB = RGB(248, 248, 248)
ellipse.Line.ForeColor.RGB = RGB(0, 90, 175)
ellipse.Line.Weight = 4
Selection.Offset(0, Value).Select
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das Makro ansich funktioniert. Bekomme einen versetzten Kringel per Mausklick.

Über WENN und die Zusatzfunktion bekomme ich zwar auch einen Kringel, doch nicht versetzt. Was übersehe ich? Nimmt er den falschen Zellenbezug als ActiveCell und springt deshalb nicht? Er zeigt auch "0" an obwohl ich das nicht absichtlich programmiert habe *Smilie

Anbei das Beispiel.

Vielen Dank für die Hilfe!

Liebe Grüße
Falko

:)

falko_d, 25. Oktober 2020

#1
BEVERLY

Beverly

Hi Falko,

ergänze diese Zeile:

Code:

ellipse.Left = Selection.Offset(0, -Value).Left
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Und die beiden Zeilen mit Selection.Offset(0, -Value).Select kannst du weglassen, denn sie bewirken in einer Function nichts.

Beverly, 27. Oktober 2020

#2
FALKO_D

falko_d

Hallo Karin,
Danke für deinen Tip!

Mit der Zeile springt leider der Debugger an und markiert sie mir.

Folgendes habe ich nun versucht zu starten:
Code:

Sub ellipse_woanders_einfügen()
Dim Länge%, Höhe%, ellipse
Länge = 14
Höhe = 14
Value = 20
ellipse.Left = Selection.Offset(0, -Value).Left
Set ellipse = ActiveSheet.Shapes.AddShape(msoShapeOval, ActiveCell.Left - Länge / 2, ActiveCell.Top + (ActiveCell.Height - Höhe) / 2, Länge, Höhe)
ellipse.Fill.Visible = msoTrue
ellipse.Fill.ForeColor.RGB = RGB(248, 248, 248)
ellipse.Line.ForeColor.RGB = RGB(0, 90, 175)
ellipse.Line.Weight = 4
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Klappt leider nicht. Aber ich glaube wir sind nah dran! *biggrin.gif*

falko_d, 29. Oktober 2020

#3
WS-53

WS-53

WENN Makro

Hallo Falko,

du hast noch eine offene Baustelle, zu der eine Rückmeldung fehlt !!!

WS-53, 29. Oktober 2020

#4
FALKO_D

falko_d

Hoppla, danke! Die Email Benachrichtigungen funktionieren nicht mehr...

falko_d, 29. Oktober 2020

#5
EARLFRED

EarlFred

Was aus deiner Frage überhaupt nicht hervorgeht: Relativ zu welcher Zelle soll denn der "Kringel" eingefügt werden? Relativ zu der Zelle, in der deine Formel steht oder relativ zu der Zelle H2?

Nachfolgend wird relativ zur Zelle mit der Formel eingefügt:
Code:

Option Explicit

'Aufruf aus anderem Code, z. B. mittels Button:
'Sub start()
'Call ellipse_woanders_einfügen
'End Sub

Function ellipse()
If TypeName(Application.Caller) = "Range" Then
Call ellipse_woanders_einfügen(rngBezug:=Application.Caller)
ellipse = "Kringel gemalt"
Else
ellipse = "kein Kringel"
End If

End Function

Sub ellipse_woanders_einfügen(Optional ByRef rngBezug As Range)
Dim Länge As Integer
Dim Höhe As Integer
Dim Spaltenversatz As Long

Dim rngAnker As Range

Länge = 14
Höhe = 14
Spaltenversatz = 5

If rngBezug Is Nothing Then Set rngBezug = ActiveCell
Set rngAnker = rngBezug.Offset(, -Spaltenversatz)
With ActiveSheet.Shapes.AddShape( _
Type:=msoShapeOval, _
Left:=rngAnker.Left - Länge / 2, _
Top:=rngAnker.Top + (rngAnker.Height - Höhe) / 2, _
Width:=Länge, _
Height:=Höhe)
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(248, 248, 248)
.Line.ForeColor.RGB = RGB(0, 90, 175)
.Line.Weight = 4
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Bitte nutze Option Explicit.

Er zeigt auch "0" an obwohl ich das nicht absichtlich programmiert habe
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Du solltest aber etwas vorgeben: den Rückgabewert deiner Function (sonst ist er eben 0) und den Typ des Rückgabewerts. Den Rückgabewert habe ich mal demonstriert, den Typ passend zum von dir gewollten Rückgabewert vorzugeben schaffst du sicher.

EarlFred, 29. Oktober 2020

#6
BEVERLY

Beverly

Hi Falko,

wenn du die Zeile VOR dem Erstellen des Shapes einfügst, KANN das natürlich nicht funktionieren und ergibt einen Fehler, denn sie ist ja noch gar nicht da, also der Variablen "ellipse" wurde noch gar kein Objekt zugewiesen... Die Codezeile muss also auf jeden Fall NACH der Zeile Set ellipse = ... stehen.

Beverly, 29. Oktober 2020

#7
FALKO_D

falko_d

WENN Makro

Hallo Karin,

vielen Dank. So einfach kann es natürlich gehen *tongue.gif*

Ich würde nun gerne "Value" (in ellipse_woanders_einfügen() als den geänderten Zellenwert definieren. Sagen wir unter "Wert bitte" steht 2, dann soll der Kringel zwei nach links verschoben eingefügt werden. Wenn dort steht 7, dann entsprechend um 7 Spalten nach links verschoben. Ich weiß nur leider nicht, wie ich das programmieren kann, ohne eine gezielte Zelle zu wählen, da ich die =WENN Funktion gerne in verschiedenen Zeilen mit dem selben Makro ansteuern würde.
Sodass ich z.B. über 10 Zeilen verteilt Kringel über mein Makro erstelle, indem ich nur in der jeweiligen Zeile unter "Wert bitte" eine Zahl eintrage.

Danke vielmals für eure Hilfe!

Falko

falko_d, 1. November 2020

#8
FALKO_D

falko_d

Und zack, gelöst.

Value = ActiveCell.Value

Da ich ja immer in der entsprechenden Zelle stecke, wenn ich sie ändere.

JUCHEE! Vielen Dank!

Und lieben Gruß
Falko

falko_d, 1. November 2020

#9
FALKO_D

falko_d

Hallo,

komischerweise fügt mein Makro manchmal wie gewünscht eine, manchmal jedoch mehrere (in der Regel 6) Ellipsen ein.

Weiß jemand, woran das liegt und wie ich das beheben kann?

Benutze noch immer das hier, aktiviert über =WENN und eine Funktion

Code:

Sub ellipse_woanders_einfügen()

Dim Länge%, Höhe%, ellipse
Länge = 14
Höhe = 14
Value = ActiveCell.Value
Set ellipse = ActiveSheet.Shapes.AddShape(msoShapeOval, ActiveCell.Left, ActiveCell.Top + (Höhe / 3), Länge, Höhe)
ellipse.Left = Selection.Offset(0, -(72 - (Value * 4))).Left - (Länge / 2)
ellipse.Fill.Visible = msoTrue
ellipse.Fill.ForeColor.RGB = RGB(248, 248, 248)
ellipse.Line.ForeColor.RGB = RGB(0, 90, 175)
ellipse.Line.Weight = 4

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Vielen Dank für eure Hilfe

Liebe Grüße
Falko

falko_d, 11. November 2020

#10
EARLFRED

EarlFred

Anstelle dieses fehleranfälligen Konstrukts aus Formel, Makro, Activecell- und Selection-Gewurschtel nutze besser das Change-Ereignis - das erfüllt das Vorhaben deutlich zuverlässiger:
Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'Eingabebereich
Dim rngEingabebereich As Range
Dim rngAktuell As Range

'Anpassen!
Set rngEingabebereich = Me.Range("AG2:AG100")

If Not Intersect(Target, rngEingabebereich) Is Nothing Then
For Each rngAktuell In Intersect(Target, rngEingabebereich)
Call ellipse_woanders_einfügen(rngAnker:=rngAktuell)
Next rngAktuell
End If
End Sub

Sub ellipse_woanders_einfügen(ByRef rngAnker As Range)

Dim Versatz As Long
Dim Breite As Single
Dim Höhe As Single
Dim ellipse As Shape

If LöscheAlteEllipse(rngAnker:=rngAnker) Then

Versatz = -(72 - (rngAnker.value * 4))
Höhe = 14
Breite = 14

If rngAnker.Column + Versatz > 0 Then

Set ellipse = rngAnker.Worksheet.Shapes.AddShape( _
Type:=msoShapeOval, _
Left:=Application.Max(rngAnker.Offset(0, Versatz).Left - (Breite / 2), 0), _
Top:=rngAnker.Top + (Höhe / 3), _
Width:=Breite, _
Height:=Höhe)

With ellipse
.Name = "ell!" & rngAnker.Address
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(248, 248, 248)
.Line.ForeColor.RGB = RGB(0, 90, 175)
.Line.Weight = 4
End With

End If
End If
End Sub

Function LöscheAlteEllipse(ByRef rngAnker As Range) As Boolean
On Error Resume Next
rngAnker.Worksheet.Shapes("ell!" & rngAnker.Address).Delete
On Error GoTo 0

LöscheAlteEllipse = Err = 0
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der Code gehört in das Modul des Worksheets, in dem du die Eingaben überwachen willst. Den zu überwachenden Bereich (im Beispiel willkürlich auf AG2:AG100 gesetzt) musst du freilich anpassen.
Der Code räumt alte, nicht mehr benötigte Ellipsen auch wieder auf - im Gegensatz zu deinem Code, der einfach neue ins Blatt kleistert.

EarlFred, 12. November 2020

#11
FALKO_D

falko_d

Hallo EarlFred,

das ist ein klasse Code! Funktioniert einwandfrei *Smilie Vielen Dank für die Mühe! Ich glaube ich verstehe sogar fast die Hälfte!

Um nun einige Zeilen drunter in einem Abschnitt Vierecke einzufügen habe ich den Code umgestellt:

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'Eingabebereich
Dim rngEingabebereich As Range
Dim rngAktuell As Range

'Anpassen!
Set rngEingabebereich = Me.Range("CF117:CF121")

If Not Intersect(Target, rngEingabebereich) Is Nothing Then
For Each rngAktuell In Intersect(Target, rngEingabebereich)
Call viereck_woanders_einfügen(rngAnker:=rngAktuell)
Next rngAktuell
End If
End Sub

Sub viereck_woanders_einfügen(ByRef rngAnker As Range)

Dim Versatz As Long
Dim Breite As Single
Dim Höhe As Single
Dim viereck As Shape

If LöscheAltesViereck(rngAnker:=rngAnker) Then

Versatz = -(72 - (rngAnker.Value * 4))
Höhe = 9
Breite = 9

If rngAnker.Column + Versatz > 0 Then

Set viereck = rngAnker.Worksheet.Shapes.AddShape( _
Type:=msoShapeRectangle, _
Left:=Application.Max(rngAnker.Offset(0, Versatz).Left - 4, 0), _
Top:=rngAnker.Top + 6, _
Width:=Breite, _
Height:=Höhe)

With viereck
.Name = "vier!" & rngAnker.Address
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(248, 248, 248)
.Line.ForeColor.RGB = RGB(0, 90, 175)
.Line.Weight = 4.5
.Rotation = 45
End With

End If
End If
End Sub

Function LöscheAltesViereck(ByRef rngAnker As Range) As Boolean
On Error Resume Next
rngAnker.Worksheet.Shapes("vier!" & rngAnker.Address).Delete
On Error GoTo 0

LöscheAltesViereck = Err = 0
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Auch der funktioniert einwandfrei. Anderer Bereich, andere Form, alles super. Für Dreiecke hat es auch schon geklappt.

Was ich nun nicht verstehe ist, wie ich den Code einarbeiten muss, sodass ich sowohl die Ellipsen von Zeile 93-98, Dreiecke 103-112 und Vierecke 117-121 eingefügt werden. (Diese Bereiche ändern sich auch oft)
Geht das in einem Modul? Oder wie löse ich das am geschicktesten?

Vielen lieben Dank für die Hilfe!

Gruß
Falko

falko_d, 16. November 2020

#12
FALKO_D

falko_d

WENN Makro

Da fällt mir ein: wenn ich Spalten lösche muss ich das entsprechend auch im Code anpassen. Das ist kein großes Problem, ich frage mich nur, ob das evtl einfacher geht. Den Eingabebereich und den Versatz 72 muss ich ändern.

LG
Falko

falko_d, 16. November 2020

#13
EARLFRED

EarlFred

sowohl die Ellipsen von Zeile 93-98, Dreiecke 103-112 und Vierecke 117-121 eingefügt werden
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
'Eingabebereich
Dim rngEingabebereichElli As Range
Dim rngEingabebereichDrei As Range
Dim rngEingabebereichVier As Range
Dim rngAktuell As Range

'Anpassen!
Set rngEingabebereichElli = Me.Range("CF117:CF121")
Set rngEingabebereichDrei = Me.Range("CF190:CF222")
Set rngEingabebereichVier = Me.Range("CF333:CF444")

If Not Intersect(Target, rngEingabebereichElli) Is Nothing Then
For Each rngAktuell In Intersect(Target, rngEingabebereichElli)
Call ellipse_woanders_einfügen(rngAnker:=rngAktuell)
Next rngAktuell
End If

If Not Intersect(Target, rngEingabebereichDrei) Is Nothing Then
For Each rngAktuell In Intersect(Target, rngEingabebereichDrei)
Call dreiiecke_woanders_einfügen(rngAnker:=rngAktuell)
Next rngAktuell
End If

If Not Intersect(Target, rngEingabebereichVier) Is Nothing Then
For Each rngAktuell In Intersect(Target, rngEingabebereichVier)
Call viereck_woanders_einfügen(rngAnker:=rngAktuell)
Next rngAktuell
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Man könnte die Prozedur für die Formen vereinheitlichen (eine Prozedur mit Übergabeparameter für die unterschiedlichen Formen). Das wäre eine gute Übung.

Spalten einfügen / löschen: Schau dir die Möglichkeit von benannten Bereichen an.

EarlFred, 17. November 2020

#14
FALKO_D

falko_d

Ah das klingt super. Dann nehme ich noch Named Range mit rein, dann sollte es so klappen, wie ich es mir vorstelle.

Vielen Dank!

falko_d, 22. November 2020

#15

(Du musst angemeldet oder registriert sein, um eine Antwort erstellen zu können.)

Seite 1 von 3

Thema:

WENN Makro

Die Seite wird geladen...

WENN Makro - Similar Threads - Makro
mehrere Tabellenblätter über eine Schaltfläche mit nur einem Makro sortieren.
in Microsoft Excel Hilfe
mehrere Tabellenblätter über eine Schaltfläche mit nur einem Makro sortieren.: Hallo Liebes Forum! Würde wieder eure Hilfe benötigen. Ich habe eine Excel mit mehreren Tabellenblättern, die Inhaltlich im Bereich A9:M33 (können auch noch mehr Zeilen werden) alle gleich sind....
User Defined Functions (UDF) auch ohne VBA / Makro möglich ?
in Microsoft Excel Hilfe
User Defined Functions (UDF) auch ohne VBA / Makro möglich ?: Moin, Ich hab ne ganz einfache Frage, die sich wohl direkt mit Ja oder Nein beantworten läßt. Meine Tabelle ist 450 Zeilen hoch und 365 Spalten breit. *eek.gif* In jeder Zelle ist die gleiche...
Save As im Makro
in Microsoft Excel Hilfe
Save As im Makro: Hallo Zusammen , benutze ein Makro um eine Exceldatei alle 10 Minuten zu speichern. Das Makro wird beim öffnen der Datei gestartet. Nun haben sich einige Umstände geändert, so das die Datei auch...
Gekennzeichnete Spalten mit WENN-Bedingung in Makro nach 5 Tabellen kopieren
in Microsoft Excel Hilfe
Gekennzeichnete Spalten mit WENN-Bedingung in Makro nach 5 Tabellen kopieren: Hallo, Ich habe ein Makro, welches ich gerne ein wenig erweitern möchte, um mir bei der Weiterverarbeitung der Ergebnisse deutlich Zeit zu sparen. Da dies meine sehr rudimentären Makrokenntnisse...
Makro Zeilen kopieren und einfügen nach Bedingung
in Microsoft Excel Hilfe
Makro Zeilen kopieren und einfügen nach Bedingung: Hallo liebe Community, für eine Vertragsanpassung möchte ich eine Liste mit mehreren 1000 Einträgen (Zeilen) überarbeiten. Auf Grund des juristischen Vorgehens ist es wichtig, die Vorher/Nachher...
Benötige sehr variables Makro
in Microsoft Excel Hilfe
Benötige sehr variables Makro: Hallo zusammen, Ich benötige Hilfe für ein Makro wo ich nicht weiter komme.... Das Makro muss folgendes „Können“: 1. Seite „Tourenplan“ auswählen 2. Spalte B soll kopiert werden aber nur wenn...
Listenverweis / "Ja" "Nein"-option
in Microsoft Excel Hilfe
Listenverweis / "Ja" "Nein"-option: Guten Tag, bin neu hier und ein ziemlicher Anfänger betreffend .xlsx. Habe folgende Aufgabenstellung, bei der ich einfach keine vernünftige Lösung hinkriege: in Exel-Datei Mitglieder.xlsx werden...

Anmelden oder registrieren

Suche