MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads Der Renner, 11 Entwicklertools für Access, Tipps & Trick und offene Datenbanken zum einzigartigen Preis.
Themen-Optionen Ansicht
Alt 02.01.2018, 16:11   #1
manega
MOF User
MOF User
Standard VBA - addieren im gleichen Feld rückgängig machen

Hallo,

ich habe hier im Forum einen Code gefunden, welcher bei der Eingabe eines Wertes in eine Zelle den eingegebenen Wert und einen evtl vorhandenen Wert addiert.
Code:

Public letzterWert 
Public aendern As Boolean 
Private Sub Worksheet_Change(ByVal Target As Range) 
   If Application.Intersect(Target, ActiveSheet.Range("B9:CB2000")) Is Nothing Then Exit Sub 
   If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub 
   If aendern = False Then Exit Sub 
   Application.EnableEvents = False 
   Target = Target + letzterWert 
   letzterWert = 0 
   aendern = False 
   Application.EnableEvents = True 
End Sub 
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
   If Application.Intersect(Target, ActiveSheet.Range("B9:CB2000")) Is Nothing Then Exit Sub 
   If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub 
   letzterWert = Target.Value 
   aendern = True 
End Sub
Leider kann man bei einer falschen Eingabe diese Aktion nicht mehr rückgängig machen.
Gibt es auch eine Möglichkeit mit der das möglich ist?

Hier mein vollständiger Code im Tabellenmodul:
Code:

Public letzterWert
Public aendern As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
' addiert Eingabewerte zu vorhandenen Werten direkt bei Eigabe
   If Application.Intersect(Target, ActiveSheet.Range("B9:CB2000")) Is Nothing Then Exit Sub 'CB2000
   If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub
   If aendern = False Then Exit Sub
   Application.EnableEvents = False
   Target = Target + letzterWert
   letzterWert = 0
   aendern = False
   Application.EnableEvents = True
   
       Dim rng As Range
    If Target.Count > 1 Then Exit Sub
    Set rng = Union(Range("B28:B32"), Range("B38:B42"), Range("B143:B144"), Range("C5"), Range("U9"), Range("I9"), Range("V9:X9"), Range("J9:J32"), Range("AK9"), Range("AL9"), Range("AO9"), Range("AZ5"))
    If Intersect(Target, rng) Is Nothing Then Exit Sub
    
    
' addiert Netzgeräte
' Führt Code aus Modul06 aus aus
    If Not Intersect(Target, Range("AO9")) Is Nothing Then
        If Target > 0 Then UserForm7.Show
    End If
        
' Führt Code aus Modul06 aus aus
    If Not Intersect(Target, Range("J9:J32")) Is Nothing Then
        If Target > 0 Then Abfrage_HV
    End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Application.Intersect(Target, ActiveSheet.Range("B9:CB2000")) Is Nothing Then Exit Sub
   If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub
   letzterWert = Target.Value
   aendern = True
End Sub


Private Sub Worksheet_Activate()

    Application.ScreenUpdating = False
    
Call Einzel_Blattschutz_aktiv_aufheben

    Columns("C:BT").AutoFit
    
Call Einzel_Blattschutz_aktiv_setzen

    Application.ScreenUpdating = True
    
End Sub
Und gibt es vielleicht auch eine Möglichkeit diese Funktion (nur das Addieren) per Makro je nach Bedarf zu Aktivieren / deaktivieren?

Vielen Dank im Voraus
maneg
manega ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 02.01.2018, 16:24   #2
lupo1
MOF Koryphäe
MOF Koryphäe
Standard

VBA kann nur manuelle Aktionen rückgängig machen, kein VBA-Ereignis bzw. VBA.

Du könntest jedoch den alten Wert jeweils beim Additions-Ereignis immer speichern (in einer Zelle, einer globalen Variablen oder einem definierten Namen) und dann mittels UNDO-Makro wieder einsetzen.

__________________

MfG Lupo - und ein Hallo ebenfalls!
lupo1 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 02.01.2018, 18:25   #3
manega
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Lupo,

vielen Dank für deine Antwort.
Leider habe ich nicht viel Ahnung von VBA. Könntest du mir das bitte genauer erklären?

Zitat:

Du könntest jedoch den alten Wert jeweils beim Additions-Ereignis immer speichern (in einer Zelle, ...

Wird der alte Wert, egal aus welcher Zelle immer in ein und die selbe Zelle gespeichert, oder brauche ich für alle betroffenen Zelle noch einmal die gleiche Anzahl Zellen worin die alten Werte gespeichert werden?
Wie würde ein Code dafür aussehen?

Zitat:

und dann mittels UNDO-Makro wieder einsetzen

Das sagt mir gar nichts! Vielleicht hast du da auch ein paar Erklärungen für mich!

Gruß
manega
manega ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 02.01.2018, 19:07   #4
lupo1
MOF Koryphäe
MOF Koryphäe
Standard

Da ich dafür vermutlich 30 Minuten brauche, andere jedoch nur 3, warte am besten noch etwas.

__________________

MfG Lupo - und ein Hallo ebenfalls!
lupo1 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 03.01.2018, 06:42   #5
aloys78
MOF Meister
MOF Meister
Standard

Hallo manega,

im Anhang mein Lösungsvorschlag.
Ersetzt werden der 1. Teil Deiner Sheet_Change Prozedur sowie die Selection_Change Prozedur.

Die Lösung ist auf Deine Bereichsgrenzen zugeschnitten und kann mit der Beispieldatei getestet werden.

Zu Beginn wird der Bereich in ein Array geladen; auf dieser Grundlage werden die Aktionen gesteuert.
Die Rücknahme von Werten ist hintereinander immer nur 1 x möglich und setzt eine vorherige Eingabe voraus.

Gruß
Aloys
Angehängte Dateien
Dateityp: xlsm manega_undo.xlsm (23,4 KB, 2x aufgerufen)
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 03.01.2018, 10:11   #6
aloys78
MOF Meister
MOF Meister
Standard

Hallo manega,

anbei eine neue Version.
Eine fehlerhafte Eingabe wird jetzt durch 0 ersetzt.
Außerdem habe ich ein paar Kommentare eingefügt.

Gruß
Aloys
Angehängte Dateien
Dateityp: xlsm manega_undo V2.xlsm (25,9 KB, 4x aufgerufen)
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 03.01.2018, 22:03   #7
manega
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

hab vielen Dank für deine Mühe. Ich verstehe zwar kaum etwas davon, aber es funktioniert soweit!
Ich habe bis jetzt nur etwas in deiner Beispieldatei herumprobiert und werde die nächsten Tage versuchen es in meine Datei umzusetzen.
Allerdings habe ich noch 2 Fragen zu deiner Datei:

1. Warum werden die Zellen nach einer Eingabe gelb? Kann man das irgendwie ändern? Die Zellen sollen ihre vordefinierte Zellenfarbe behalten.

2. Mir ist aufgefallen, dass man den Zelleninhalt nicht entfernen kann. Zumindest nicht mit der Del-Taste. Mit der Funktion "Inhalte löschen" ist die Zelle zwar augenscheinlich leer, aber bei erneuter Eingabe wird der vorherige Wert mit dem neu eingegeben Wert addiert.
Ich brauche aber unbedingt eine Möglichkeit die Zellen wieder zu leeren! In meiner Datei werden verschiedene Bereiche per Makro mit Delete geleert.

Nochmals vielen Dank
manega
manega ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 03.01.2018, 22:46   #8
aloys78
MOF Meister
MOF Meister
Standard

Hallo manega,

Zitat:

1. Warum werden die Zellen nach einer Eingabe gelb? Kann man das irgendwie ändern? Die Zellen sollen ihre vordefinierte Zellenfarbe behalten.

Das kann ich nicht nachvollziehen.
In meiner Testdatei ist der Testbereich gelb markiert, aber keine Zelle wird durch den Code eingefärbt.
Wenn das bei Deiner Datei sein sollte, setzt Du ggf eine BF ein !

Zitat:

2. Mir ist aufgefallen, dass man den Zelleninhalt nicht entfernen kann.

Das wird so stimmen, war aber auch nicht gefordert.
Darin siehst Du, wichtig es ist, die Anforderungen möglichst präzise zu formulieren.

Ich habe das zur Kenntnis genommen und werde mir morgen eine Lösung einfallen lassen.
Ich fasse zusammen:
- die Eingabe einer 0 wird wie eine gewöhnliche Zahl behandelt
- das Löschen einer Zelle setzt deren Bestand auf 0

Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 04.01.2018, 04:34   #9
manega
Threadstarter Threadstarter
MOF User
MOF User
Standard

Guten Morgen Aloys,

ich habe noch nie mit so einer Tabelle gearbeitet und konnte mir daher nicht vorstellen, dass dort alles etwas anders ist.
Für meine Zwecke ist es wichtig, dass man die sichtbaren Werte der Zellen kopieren, anschließend in einer anderen Tabelle einfügen und auch wieder entfernen kann. Und das so, dass die Zellen dann auch leer sind, also möglchst auch keine Null drin steht!

Gruß
manega
manega ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 04.01.2018, 07:23   #10
aloys78
MOF Meister
MOF Meister
Standard

Hallo manega,

Zitat:

ich habe noch nie mit so einer Tabelle gearbeitet und konnte mir daher nicht vorstellen, dass dort alles etwas anders ist.

Und ich habe noch nie mit solch einer etwas ausgefallenen Aufgabenstellung zu tun gehabt (siehe auch hierzu den Beitrag von Lupo).

Zitat:

Für meine Zwecke ist es wichtig, dass man die sichtbaren Werte der Zellen kopieren, anschließend in einer anderen Tabelle einfügen und auch wieder entfernen kann. Und das so, dass die Zellen dann auch leer sind, also möglchst auch keine Null drin steht!

Ich interpretiere das so:
- ein angezeigter Wert (= Summe der bisher erfolgten Eingaben) soll kopiert werden können,
- ein angezeigter Wert soll gelöscht werden können; es ist dann eine leere Zelle anzuzeigen.

Hierfür dient der nachfolgende Code, der den bisherigen in Tabelle1 vollständig ersetzt. Er erscheint "ein wenig" umfangreicher, weil ich noch einige Kommentare zum besseren Verständnis eingefügt habe.

Im übrigen vermisse ich eine Aussage zum Farbproblem.

Gruß
Aloys

Code:

Option Explicit

' Version V3 vom 04.01.2018

Dim a As Long                           ' Index Array pArray

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'===========================================================================================================
' Rücknahme der letzten Eingabe
'   Im Array ist für jede Zelle des relevanten Bereiches eine Information hierzu in pArray(a, 3) gespeichert
'       Wert = 0     eine Rücknahme der letzten Eingabe ist möglich
'       Wert = 1     eine Rücknahme der letzten Eingabe ist nicht möglich
'   Der Wert ist standardmäßig 0.
'   Er wird auf 1 gesetzt
'       - nach einer Rücknahme
'       - nach einer Löschung der angezeigten Summe
'   Er wird auf 0 gesetzt
'       - nach Eingabe einer Zahl
'===========================================================================================================
    If Application.Intersect(Target, ActiveSheet.Range(rng)) Is Nothing Then Exit Sub
    Cancel = True
    a = pIndx(Target)                   ' übersetze Target-Adresse in Index für pArray
    If pArray(a, 3) = 0 Then            ' für aktuelle Zelle in Tabelle gab es unmittelbar vorher keine Rücknahme
        pArray(a, 2) = pArray(a, 1)     ' der zuletzt eingegebene Wert wird ersetzt durch die vorherige Summe
        pArray(a, 1) = 0                ' Grundstellung
        pArray(a, 3) = 1                ' Schalter für erfolgte Rücknahme
        Application.EnableEvents = False
        Target = pArray(a, 2)           ' ersetze Target durch frühere Summe
        Application.EnableEvents = True
    Else
        MsgBox "Rücknahme von Eingaben ist nicht möglich !", vbExclamation
    End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
'===========================================================================================================
' Änderung der aktuellen Summe ist erfolgt
'   Case 1: die angezeigte Summe wurde gelöscht
'               Die bisher gespeicherten Werte werden auf 0 gesetzt, und
'               eine Rücknahme ist nicht möglich
'   case 2: Zelle enthält einen nicht numerischen Ausdruck
'               Der Ausdruck wird durch 0 ersetzt; ansonsten erfolgt Verarbeitung wie in Case 3
'   Case 3: eine Zahl wurde einegegebn
'               Die bisherigen Werte in pArray(a, 1) und pArray(a, 2) werden als Summe in pArray(a, 1)
'               gespeichert, und der neu eingebene Wert wird nach pArray(a, 2) übernommen.
'               In Target wird dann die Summe der beiden Array_Felder ausgegeben
'===========================================================================================================
    Dim Summe As Long                           ' anzuzeigendes Ergebnis nach Eingabe
' check, ob Änderung im vorgegebenen Bereich erfolgte, bzw ob nur eine Zelle verändert wurde
    If Application.Intersect(Target, ActiveSheet.Range(rng)) Is Nothing Then Exit Sub   ' außerhalb Bereich
    If Target.CountLarge > 1 Then Exit Sub      ' nur eine Zelle erlaubt
    
    a = pIndx(Target)                           ' übersetze Target-Adresse in Index für pArray
    
' Case 1
    If Target = "" Then                         ' vorhandene Summe wurde gelöscht
        pArray(a, 1) = 0                            ' bisherige Teilsumme löschen
        pArray(a, 2) = 0                            ' aktuellen Wert in Grundstellung 0
        pArray(a, 3) = 1                            ' Schalter für Rücknahme setzen = keine Rücknahme möglich
    
' Case 2 und 3
    Else
        Summe = IIf(IsNumeric(Target), Target, 0)   ' Target enthält eine Zahl (Case 3) bzw
                                                    '   bzw wurde bei nicht-numerischer Eingabe auf 0 gesetzt (Case 3)
        pArray(a, 1) = pArray(a, 1) + pArray(a, 2)  ' Summe bisheriger Eingaben
        pArray(a, 2) = Summe                        ' aktuelle Eingabe
        pArray(a, 3) = 0                            ' Schalter für Rücknahme von Eingaben in Grundstellung = Rücknahme möglich
        Summe = Summe + pArray(a, 1)                ' bilde Summe aus bisherigen und der aktuellen Eingabe
        Application.EnableEvents = False
        Target = Summe                              ' ersetze in Target den Eingabewert durch die neue Summe
        Application.EnableEvents = True
    End If
End Sub
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 04.01.2018, 19:50   #11
manega
Threadstarter Threadstarter
MOF User
MOF User
Standard

Vielen Dank Aloys,

ich habe deinen Code gerade mal in meiner Datei getestet. Er funktioniert bisher super!
Ich habe in meinem Code im Anfangsbeitrag allerdings noch einen Code Abschnitt enthalten, welcher mir beim Einfügen in deinen Code die Fehlermeldung "Mehrfachdeklaration im aktuellen Gültigkeitsbereich" verursacht.
Code:

       Dim rng As Range
    If Target.Count > 1 Then Exit Sub
    Set rng = Union(Range("B28:B32"), Range("B38:B42"), Range("B143:B144"), Range("C5"), Range("U9"), Range("I9"), Range("V9:X9"), Range("J9:J32"), Range("AK9"), Range("AL9"), Range("AO9"), Range("AZ5"))
    If Intersect(Target, rng) Is Nothing Then Exit Sub
    
    
' addiert Netzgeräte
' Führt Code aus Modul06 aus aus
    If Not Intersect(Target, Range("AO9")) Is Nothing Then
        If Target > 0 Then UserForm7.Show
    End If
        
' Führt Code aus Modul06 aus aus
    If Not Intersect(Target, Range("J9:J32")) Is Nothing Then
        If Target > 0 Then Abfrage_HV
    End If
Ich habe ihn im Tabellenmodul in deinen Code am Ende hinter End If eingefügt.
Hier der komplette Code:
Code:

Private Sub Worksheet_Change(ByVal Target As Range)
'===========================================================================================================
' Änderung der aktuellen Summe ist erfolgt
'   Case 1: die angezeigte Summe wurde gelöscht
'               Die bisher gespeicherten Werte werden auf 0 gesetzt, und
'               eine Rücknahme ist nicht möglich
'   case 2: Zelle enthält einen nicht numerischen Ausdruck
'               Der Ausdruck wird durch 0 ersetzt; ansonsten erfolgt Verarbeitung wie in Case 3
'   Case 3: eine Zahl wurde einegegebn
'               Die bisherigen Werte in pArray(a, 1) und pArray(a, 2) werden als Summe in pArray(a, 1)
'               gespeichert, und der neu eingebene Wert wird nach pArray(a, 2) übernommen.
'               In Target wird dann die Summe der beiden Array_Felder ausgegeben
'===========================================================================================================
    Dim Summe As Long                           ' anzuzeigendes Ergebnis nach Eingabe
' check, ob Änderung im vorgegebenen Bereich erfolgte, bzw ob nur eine Zelle verändert wurde
    If Application.Intersect(Target, ActiveSheet.Range(rng)) Is Nothing Then Exit Sub   ' außerhalb Bereich
    If Target.CountLarge > 1 Then Exit Sub      ' nur eine Zelle erlaubt
    
    a = pIndx(Target)                           ' übersetze Target-Adresse in Index für pArray
    
' Case 1
    If Target = "" Then                         ' vorhandene Summe wurde gelöscht
        pArray(a, 1) = 0                            ' bisherige Teilsumme löschen
        pArray(a, 2) = 0                            ' aktuellen Wert in Grundstellung 0
        pArray(a, 3) = 1                            ' Schalter für Rücknahme setzen = keine Rücknahme möglich
    
' Case 2 und 3
    Else
        Summe = IIf(IsNumeric(Target), Target, 0)   ' Target enthält eine Zahl (Case 3) bzw
                                                    '   bzw wurde bei nicht-numerischer Eingabe auf 0 gesetzt (Case 3)
        pArray(a, 1) = pArray(a, 1) + pArray(a, 2)  ' Summe bisheriger Eingaben
        pArray(a, 2) = Summe                        ' aktuelle Eingabe
        pArray(a, 3) = 0                            ' Schalter für Rücknahme von Eingaben in Grundstellung = Rücknahme möglich
        Summe = Summe + pArray(a, 1)                ' bilde Summe aus bisherigen und der aktuellen Eingabe
        Application.EnableEvents = False
        Target = Summe                              ' ersetze in Target den Eingabewert durch die neue Summe
        Application.EnableEvents = True
    End If 'Ende Prozedur
    
       Dim rng As Range
    If Target.Count > 1 Then Exit Sub
    Set rng = Union(Range("B28:B32"), Range("B38:B42"), Range("B143:B144"), Range("C5"), Range("U9"), Range("I9"), Range("V9:X9"), Range("J9:J32"), Range("AK9"), Range("AL9"), Range("AO9"), Range("AZ5"))
    If Intersect(Target, rng) Is Nothing Then Exit Sub
    
    
' addiert Netzgeräte
' Führt Code aus Modul06 aus aus
    If Not Intersect(Target, Range("AO9")) Is Nothing Then
        If Target > 0 Then UserForm7.Show
    End If
        
' Führt Code aus Modul06 aus aus
    If Not Intersect(Target, Range("J9:J32")) Is Nothing Then
        If Target > 0 Then Abfrage_HV
    End If
   

End Sub
Könntest du mir bitte den Code an die richtige Stelle schreiben oder halt so, dass er funktioniert?

Zitat:

Im übrigen vermisse ich eine Aussage zum Farbproblem

Das hat sich beim Einfügen der Codes in meine Datei erledigt. Nachdem ich die gelben Markierungen in deiner Beispieldatei entfernt hatte ging es auch dort!

Eine Bitte hätte ich dann noch. Ich weiß, es war nicht unbedingt Bestandteil meiner Fragestellung, bzw. nur im Anfangsbeitrag als meine 2. Frage.

Zitat:

Und gibt es vielleicht auch eine Möglichkeit diese Funktion (nur das Addieren) per Makro je nach Bedarf zu Aktivieren / deaktivieren?

Dafür habe ich in der Zwischenzeit selber eine Lösung gefunden, die allerdings bei deinem Code nicht mehr funktioniert!
Ich habe den Zellbereich B9:CB2000 einfach per Makros auf A1:B1 reduziert und wieder zurück. Diese Bereiche stehen in einem ausgeblendetem Tabellenblatt und werden dort wie gesagt per Makros geändert.
Im bisherigen originalen Code lautete der Code so:
Code:

Public letzterWert
Public aendern As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
' addiert Eingabewerte zu vorhandenen Werten direkt bei Eigabe
   If Application.Intersect(Target, ActiveSheet.Range("B9:CB2000")) Is Nothing Then Exit Sub 'CB2000
   If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub
damit sich der Code den Bereich aus der Tabelle holt habe ich ihn so geändert:
Code:

Public letzterWert
Public aendern As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
' addiert Eingabewerte zu vorhandenen Werten direkt bei Eigabe

    Dim strBereich1 As String
    strBereich1 = Worksheets("Übersicht Makros").Range("D101").Value & ":" & Worksheets("Übersicht Makros").Range("E101").Value
    

   If Application.Intersect(Target, ActiveSheet.Range(strBereich1)) Is Nothing Then Exit Sub 'Bereich steht in ausgeblendeter Tabelle Übersicht Makros!
   If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub
Bei deiner Variante steht der Bereich in einem allgemeinen Modul:
Code:

Option Explicit

    Public Const rng As String = "B9:CB2000"        ' relevanter Datenbereich
Gibt es dafür auch eine Möglichkeit, dass der Bereich aus einer Tabelle gelesen wird?

Hab vielen Dank für deine Mühe
manega
manega ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 04.01.2018, 23:29   #12
aloys78
MOF Meister
MOF Meister
Standard

Hallo manega,

Zitat:

ich habe deinen Code gerade mal in meiner Datei getestet. Er funktioniert bisher super!

Das freut mich !

Zitat:

Ich habe in meinem Code im Anfangsbeitrag allerdings noch einen Code Abschnitt enthalten, welcher mir beim Einfügen in deinen Code die Fehlermeldung "Mehrfachdeklaration im aktuellen Gültigkeitsbereich" verursacht.

Deine Deklaration habe ich in rng2 geändert.

Zitat:

Könntest du mir bitte den Code an die richtige Stelle schreiben oder halt so, dass er funktioniert?

Nachstehend der leicht angepasste Code zum Anhängen an meinen bisherigen.
Testen kann ich das nicht, schon wegen der Userform.
Code:

' addiert Netzgeräte
' Führt Code aus Modul06 aus aus
    Dim rng2 As Range
    Set rng2 = Union(Range("B28:B32"), Range("B38:B42"), Range("B143:B144"), Range("C5"), _
        Range("U9"), Range("I9"), Range("V9:X9"), Range("J9:J32"), Range("AK9"), Range("AL9"), Range("AO9"), Range("AZ5"))
    If Intersect(Target, rng2) Is Nothing Then Exit Sub
    
    If Not Intersect(Target, Range("AO9")) Is Nothing Then
        If Target > 0 Then UserForm7.Show
    End If
        
' Führt Code aus Modul06 aus
    If Not Intersect(Target, Range("J9:J32")) Is Nothing Then
        If Target > 0 Then Abfrage_HV
    End If

Zitat:

Und gibt es vielleicht auch eine Möglichkeit diese Funktion (nur das Addieren) per Makro je nach Bedarf zu Aktivieren / deaktivieren?

Wenn ich das richtig verstehe, dann
- soll mein Teil der Sheet_Change Prozedur aktiviert bzw deaktiviert werden können
- bei Deaktivierung müßte dann auch der DoppelClick nicht mehr ausgeführt werden dürfen.

Wenn es nur um Aktivieren / Deaktivieren geht, dann wäre mein Vorschlag.
Wir definieren in meinem Modul1 einen globalen Schalter
Public pActivate as Boolean, der in Deinem Makro auf True (Addieren aktiviert) bzw False (Addieren deaktiviert) gesetzt wird.

Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 05.01.2018, 06:47   #13
aloys78
MOF Meister
MOF Meister
Standard

Hallo manega,

bezüglich des letzten Absatzes meines vorherigen Beitrages:

Zitat:

Wir definieren in meinem Modul1 einen globalen Schalter
Public pActivate as Boolean,

Das wird so nicht funktionieren, wenn Du während einer Session das Verfahren ändern willst.

Habe ich es denn richtig verstanden ?
- die Bereichsadresse bleibt unverändern,
- Du möchtest aber während der Session beliebig ändern, ob eine Addition erfolgen soll oder nicht.

Dazu würde ich mir dann eine Lösung einfallen lassen.

Gruß
Aloys

Geändert von aloys78 (05.01.2018 um 07:26 Uhr).
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 05.01.2018, 13:38   #14
manega
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Aloys,

Zitat:

Deine Deklaration habe ich in rng2 geändert.

Das funktioniert jetzt auch. Vielen Dank!

Zitat:

Habe ich es denn richtig verstanden ?
- die Bereichsadresse bleibt unverändert,

So wie ich es zur Zeit handhabe wird sie verändert.
Der Bereich steht wie gesagt in der ausgeblendeten Tabelle "Übersicht Makros" in den Zellen D101 und E101. Die Bereiche ändere über 2 Makros.
Ein Makro schreibt A1 und B1 zum "Deaktivieren" der Additions-Funktion in die Zellen, das andere Makro schreibt B9 und CB2000 zum "Aktivieren" der Funktion.
Der Bereich wird im Code durch folgenden Code aus der Tabelle "Übersicht Makros" ausgelesen:
Code:

    Dim strBereich1 As String
    strBereich1 = Worksheets("Übersicht Makros").Range("D101").Value & ":" & Worksheets("Übersicht Makros").Range("E101").Value
    
   If Application.Intersect(Target, ActiveSheet.Range(strBereich1)) Is Nothing Then Exit Sub 'Bereich steht in ausgeblendeter Tabelle Übersicht Makros!
   If Not IsNumeric(Target.Value) Then letzterWert = 0: Exit Sub
Am Liebsten wäre mir wenn es diese Möglichkeit auch für deine Variante gäbe. Einfach den Bereich aus einer Tabelle entnehmen.
Bemerkung: Die somit immer aktiven Zellen A1:B1 werden nicht genutzt.

Zitat:

Du möchtest aber während der Session beliebig ändern, ob eine Addition erfolgen soll oder nicht.

Normaler Weise nicht. Für Bearbeitungszwecke in der Tabelle kann es jedoch schon mal vorkommen. In Teilen der Tabelle befinden sich auch Formeln die hin und wieder mal geändert werden, oder neue hinzugefügt werden müssen.
Das hat mit der Additions-Funktion nicht funktioniert. Das Aussparen dieser Bereiche wäre ein wenig komliziert.
Außerdem wird die Tabelle von mehreren Personen genutzt. Der eine möchte lieber selber rechnen, der andere nicht.
Also muss ich deine Frage eigentlich mit Ja beantworten.

Gruß
manega
manega ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 05.01.2018, 13:53   #15
aloys78
MOF Meister
MOF Meister
Standard

Hallo manega,

Zitat:

Für Bearbeitungszwecke in der Tabelle kann es jedoch schon mal vorkommen. In Teilen der Tabelle befinden sich auch Formeln die hin und wieder mal geändert werden, oder neue hinzugefügt werden müssen.

Jetzt verstehe ich das ganze schon besser.
Kannst Du Dir dann folgendes Verfahren vorstellen.
Die beiden Makros erhalten eine neue Aufgabe: Sperren aller Zellen mit Formeln im besagten Bereich, bzw vorübergehendes Entsperren der Formelzellen, um Formeln ändern, einfügen oder löschen zu können.

Das hätte den Vorteil, dass Formeln nicht unabsichtlich verändert werden können. Auf das Additionsverfahren hätte es keinen Einfluss, da gesperrte Zellen keine Eingaben erlauben.

Was hältst Du davon ?

Gruß
Aloys
aloys78 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 16:58 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

Copyright ©2000-2010 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günther Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.
Beachten Sie bitte auch unsere Nutzungsbedingungen.