Microsoft Excel

Herbers Excel/VBA-Archiv

Makro erweitern

Betrifft: Makro erweitern von: mike49
Geschrieben am: 06.10.2007 20:14:06

Hallo zusammen,
habe ein Makro, mit dem ich durch Doppelklick in einem festgelegten Spaltenbereich in einer Zelle ein "x" erzeugen kann.
Wie müsste das Makro ergänzt werden, damit ein zuvor erzeugtes "x" durch erneuten Doppelklick wieder verschwindet?
Das Makro:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Bereich As Range
    Dim Z
    Application.EnableEvents = False
    Set Bereich = Range("E12:E29")
        For Each Z In Selection
            Dim S As String
            S = Z.Address
            If Intersect(Z, Bereich) Is Nothing Then
            Else
                Cancel = True
                Z.Value = "X"
            End If
        Next Z
Ende:
    Application.EnableEvents = True
End Sub


Gruß
mike49

  

Betrifft: AW: Makro erweitern von: Hajo_Zi
Geschrieben am: 06.10.2007 20:18:46

Hallo mike,


Option Explicit                                                 ' Variablendefinition  _
erforderlich

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'**************************************************
'* H. Ziplies                                     *
'* 18.05.07                                       *
'* erstellt von Hajo.Ziplies@web.de               *
'* http://Hajo-Excel.de/
 *
'**************************************************
    Dim RaBereich As Range
'   Bereich der Wirksamkeit
    Set RaBereich = Range("E2,E4,C23:C34,D23:D34")
'   noch mehr Bereiche
'    Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15 , C17:AG17 , C19:AG19 ,  C21: _
AG21 , C27:AE27 , C29:AE29, C31:AE31, C33:AE33"), _
'        Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49 ,C51:AG51 , C53: _
AG53 , C59:AF59 , C61:AF61 , C63:AF63 , C65:AF65"), _
'        Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81 , C83:AG83 ,  _
C85:AG85 ,C91:AF91 , C93:AF93 , C95:AF95 , C97:AF97"), _
'        Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111 , C113:AG113 , C115: _
AG115 , C117:AG117 , C123:AG123 , C125:AG125"), _
'        Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139 , C141:AF141 ,  _
C143:AF143 , C145:AF145 , C147:AF147 , C149:AF149"), _
'        Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163 , C165:AG165 ,  _
C171:AF171 , C173:AF173 , C175:AF175 , C177:AF177 "), _
'        Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191 , C193:AG193 ,  _
C195:AG195 , C197:AG197"))
    If Intersect(Target, RaBereich) Is Nothing Then Exit Sub    ' Abbruch, wenn Aktion nicht im  _
Zielbereich
    Application.EnableEvents = False                            ' Reaktion auf Eingabe aus
    Cancel = True                                               ' damit Cursor nicht in Zelle  _
nach Doppelklick
    If Target.Value = "X" Then
        Target.Value = ""                                       ' falls Zellinhalt X, Zelle  _
leeren
    Else
        Target.Value = "X"                                      ' falls Zelle leer, X eintragen
    End If
    Application.EnableEvents = True                             ' Reaktion auf Eingabe ein
    Set RaBereich = Nothing                                     ' Variable leeren
End Sub



GrußformelHomepage


  

Betrifft: warum soviel Code für so wenig "x" ? von: Matthias L
Geschrieben am: 06.10.2007 20:25:15

Hallo

Eigentlich reicht das doch schon:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Not Intersect(Target, Range("E12:E29")) Is Nothing Then
  If ActiveCell = "X" Then ActiveCell = "": Exit Sub
  If ActiveCell = "" Then ActiveCell = "X": Exit Sub
 End If
End Sub


oder übersehe ich da was ?





  

Betrifft: AW: warum soviel Code für so wenig "x" ? von: Daniel
Geschrieben am: 06.10.2007 20:39:02

Hi Matthias,
warum soviel code ;-)?
das lässt sich auch als echter 1-Zeiler schreiben.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("E12:E29")) Is Nothing Then _
                      ActiveCell.Value = Array("", "X")((ActiveCell.Value = "") * (-1))
End Sub



Gruß, Daniel


  

Betrifft: Streber ;o) oT. von: Matthias L
Geschrieben am: 06.10.2007 20:42:35




  

Betrifft: wenn schon-denn schon ;-) owt von: Daniel
Geschrieben am: 06.10.2007 20:55:36




  

Betrifft: AW: wenn schon-denn schon ;-) owt von: Original Kurt
Geschrieben am: 06.10.2007 20:56:54

Hi,

für Cancel = True solltest du nicht zu geizig sein.

mfg Kurt


  

Betrifft: AW: wenn schon-denn schon ;-) owt von: Daniel
Geschrieben am: 06.10.2007 21:22:56

Hi
kann man machen.
ich hab die direkte Zellbearbeitung nicht aktiviert, sondern arbeite immer in der Eingabezeile,
daher brauche ich Cancel = true nicht .

Gruß, Daniel


  

Betrifft: Wieso"Streber"?- Geht doch viel einfacher von: NoNet
Geschrieben am: 07.10.2007 00:26:57

Hey Matthias,

noch einfacher kann man das SO formulieren :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     If Not Intersect(Target, Range("E12:E29")) Is Nothing Then  _
Activecell=Iif(Activecell="x","","x")
End Sub


Und: Versuche bitte auf EXIT SUB zu verzichten ! Jedesmal wenn ich das sehe, reiben sich mein Augenarzt und mein Optiker wieder ihre Hände....

Gruß, NoNet


  

Betrifft: AW: Wieso"Streber"?- Geht doch viel einfacher von: Daniel
Geschrieben am: 07.10.2007 13:37:03

hi
wieso hast du ein Problem mit "Exit Sub" ?

gerade bei so Event-Gesteuerten Makros, wo es oft eine ganze Reihe von Ausschluss-Kriterien gibt, arbeite ich oft mit mit einer ganzen Reihe von

IF...Then Exit SUB


ich finde das recht übersichtlich, im oberen Teil des Codes die Prüfungen und im Unteren die Ausführung, ohne das danach noch reihenweise END IFs stehen in denen man schnell die Übersicht verliert.

Gruß, Daniel


  

Betrifft: Du und viele andere vielleicht.... von: NoNet
Geschrieben am: 07.10.2007 21:31:55

Hallo Daniel,

ich vermute mal, dass Du es nicht gleich als STANDARD deklarieren möchtest, nur weil DU damit arbeitest !!??
Ebenso wenig ist es STANDARD, nur weil ich es NICHT (bzw. nur extrem selten) verwende !
Beucher des Spotlight-EXCEL-Forums kennen mich als radikaler Verfechter der Strukturierten Programmierung - und da ist "EXIT SUB" genau das Anti-Beispiel dazu ! Meine Kritik ist also nie persönlich gemeint, sondern eher allgemeiner Natur. "EXIT SUB" ist nach meinem Verständnis auf der gleichen Stufe einzuordnen wie ".SELECT" oder ".ACTIVATE" (=Makro-Rekorder-Niveau), das sich zwar ebenfalls manchmal nicht verhindern lässt, aber eben zu ca. 99% überflüssig ist. Man muss sich eben nur etwas Gedanken darüber machen, wie man das verhindern kann (und das gilt auch für "EXIT SUB").

Schau Dir dazu auch meine Beispiele/Statements aus dem Spotlight-Forum an :

http://spotlight-wissen.de/lisp/pages/messages/amse-1179996784-5270

http://spotlight-wissen.de/lisp/pages/messages/amse-1132070740-11538

http://spotlight-wissen.de/lisp/pages/messages/amse-1178696586-5347

http://spotlight-wissen.de/lisp/pages/messages/amse-1179320507-28975

Gruß, NoNet


  

Betrifft: AW: Du und viele andere vielleicht.... von: xla
Geschrieben am: 07.10.2007 21:45:01

Hi,

du bist schon ein merkwürdiger Heiliger.

Deine Werke strotzen nur so von programmtechnischen Stockfehlern aber an
kleinen Unzulänglichkeiten Anderer ziehst du dich hoch.

Das heißt nicht, dass du nicht ein sehr guter Problemlöser bist, nur Programmieren
solltest du besser nicht.

mfg xla


  

Betrifft: AW: Du und viele andere vielleicht.... von: Daniel
Geschrieben am: 09.10.2007 00:16:41

Hi
Prinzipien sind ja gut und richtig, aber bei "Radikalen Verfechtern" besteht halt manchmal die Gefahr, daß für sie das Prinzip wichtiger ist, als das Ziel, das sie eigentlich mit diesen Prinzipen erreichen möchten.

Das Ziel ist ja nicht strukturietes Programmierung um jeden Preis, sonden ein Quellcode, der schnell, zuverlässig, leicht verständlich und leicht zu pflegen ist.
Und wenn das mit einem gezielt verwendeten Exit Sub erreicht wird, warum nicht?

btw, wenn du dich gerne für eine gute Sache einsetzt, dann können wir uns ja zusammentun und nicht nur für strukturiertes, sondern auch für schleifenarmes, die gegebenen Möglichkeiten ausnutzendes VBA-Programmieren einsetzen, denn jedes mal, wenn jemand nach einem Code fragt, wie man alle Zeilen löschen kann, die einen bestimmten Wert enthalten, kommt als erstes die Lösung mit der Schleife + IF - Abfrage, obwohl es genügend andere Möglichkeiten gibt, das Problem mit kürzerem und vorallem schnelleren Code zu lösen .
(z.b. hier: https://www.herber.de/forum/messages/914022.html )
da könnten wir auch noch viel Aufklärungsarbeit leisten.

Gruß, Daniel


  

Betrifft: Danke euch allen . . . von: mike49
Geschrieben am: 06.10.2007 21:10:10

. . . habe mich hierfür entschieden:

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim RaBereich As Range
    Application.EnableEvents = False
    Set RaBereich = Range("E12:E29")                            ' Bereich der Wirksamkeit
If Intersect(Target, RaBereich) Is Nothing Then Exit Sub        ' Abbruch, wenn Aktion nicht im  _
Zielbereich
    Application.EnableEvents = False                            ' Reaktion auf Eingabe aus
    Cancel = True                                               ' damit Cursor nicht in Zelle  _
nach Doppelklick bleibt
    If Target.Value = "X" Then
        Target.Value = ""                                       ' falls Zellinhalt X, Zelle  _
leeren
    Else
        Target.Value = "X"                                      ' falls Zelle leer, X eintragen
    End If
    Application.EnableEvents = True                             ' Reaktion auf Eingabe ein
    Set RaBereich = Nothing                                     ' Variable leeren
End Sub


Gruß
mike49


  

Betrifft: AW: Makro erweitern von: Gerd L
Geschrieben am: 06.10.2007 21:31:11

Hallo Mike,

falls im Bereich immer nur maximal ein X stehen soll.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

     Dim Bereich As Range, Z As Range

     Set Bereich = Range("E12:E29")
     Application.EnableEvents = False

     If Not Intersect(Target, Bereich) Is Nothing Then

        For Each Z In Bereich
            If Z.Value = "X" Then If Target <> Z Then Z.Value = Empty
        Next Z
        Target.Value = IIf(Target.Value = "X", Empty, "X")
       
        Cancel = True

     End If

     Application.EnableEvents = True

 End Sub



Gruß Gerd


  

Betrifft: oder so ;o) von: Matthias L
Geschrieben am: 06.10.2007 21:47:48

Hallo

oder so ...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Not Intersect(Target, Range("E12:E29")) Is Nothing Then
  Range("E12:E29").ClearContents
  If ActiveCell = "X" Then ActiveCell = "": Exit Sub
  If ActiveCell = "" Then ActiveCell = "X": Exit Sub
 End If
End Sub







  

Betrifft: AW: oder so ;o) von: Gerd L
Geschrieben am: 06.10.2007 22:03:27

Hallo Matthias,

ja, wenn im Bereich außer "X"chen keine anderen Werte stehen.

Gruß Gerd


  

Betrifft: hatte ich übersehen ;o) von: Matthias L
Geschrieben am: 06.10.2007 22:19:26

Hallo Gerd

Ja, da hast Du Recht, das hatte ich übersehen ;o)

Ich würde es dann so schreiben, aber das ist eben Geschmackssache

Option Explicit
 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 Dim C As Variant
 If Not Intersect(Target, Range("E12:E29")) Is Nothing Then
   
 For Each C In Range("E12:E29")
  If C = "X" Then C.ClearContents
 Next
   
   If ActiveCell = "X" Then ActiveCell = "": Exit Sub
   If ActiveCell = "" Then ActiveCell = "X": Exit Sub
  End If
 End Sub







 

Beiträge aus den Excel-Beispielen zum Thema "Makro erweitern"