Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
25.04.2024 21:06:05
Duplikate entfernen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1684to1688
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1684to1688
1684to1688
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Ereignis hizufügen

Ereignis hizufügen
17.04.2019 11:33:50
Helmut
Mahlzeit VBA'ler
Ein kleines Problem: im unten stehenden Makrocode möchte ich gerne, dass auch im vordefinierten Bereich „BemerkAlle“ das Makro ausgelöst wird, wenn dort irgendein Text eingegeben wird. Gibt es hierzu Hilfe?
  • 
Private Sub Worksheet_Calculate() ' Löscht die Formel im definierten Bereich und ersetzt sie  _
gegen_
' den Text "Wahr" der durch die Berechnung der Formeln  _
entstanden ist (Datenbank)
Dim objCell As Object, objRange As Object
On Error Resume Next
Application.EnableEvents = False
'Hier fehlt der Eintrag!!!!!!!!!!!!!
Set objRange = Range("DB,Zähler,BemerkAlle").SpecialCells(xlCellTypeFormulas, xlLogical)
If Not objRange Is Nothing Then
For Each objCell In objRange
If objCell.Value = True Then objCell.Value = objCell.Value
Next
End If
Application.EnableEvents = True
End Sub

    • Besten Dank im Voraus, lg Helmut

    10
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Ereignis hizufügen
    17.04.2019 12:42:40
    Nepumuk
    Hallo Helmut,
    so?
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim objRange As Range, objCell As Range
        Set objRange = Intersect(Target, Range("BemerkAlle"))
        If Not objRange Is Nothing Then
            Application.EnableEvents = False
            For Each objCell In objRange
                If Not IsEmpty(objCell.Value) Then Call Worksheet_Calculate
            Next
            Set objRange = Nothing
            Application.EnableEvents = True
        End If
    End Sub

    Gruß
    Nepumuk
    Anzeige
    AW: Ereignis hizufügen
    18.04.2019 08:38:20
    Helmut
    Guten Morgen Nepumuk
    Danke, dass du mir deine Hilfe angeboten hast. Leider macht der Code nicht was ich möchte. Ich erkläre noch einmal das ganze. Der bestehende Code, den ich gepostet habe, funktioniert tadellos. Der Bereich „DB, Zähler“ ist mit Formeln ausgelegt; ergibt diese „falsch“ wird die Formel gegen das Wort „falsch“ ersetzt.
    Im Bereich „BemerkAlle“ ist auch wiederum eine Formel enthalten wobei das Ergebnis jeder Text sein kann.
    Nun möchte ich das auch die Formel im Bereich „BemerkAlle“ gegen den Text ausgetauscht wird, den die Formel ergibt.
    Ich hoffe damit alle Unklarheiten so weit einmal beseitigt zu haben.
    Besten Dank im Voraus, Lg Helmut
    Anzeige
    AW: Ereignis hizufügen
    19.04.2019 07:48:12
    Nepumuk
    Hallo Helmut,
    was zeigen denn die Zellen an bevor ein Text erscheint?
    Gruß
    Nepumuk
    AW: Ereignis hizufügen
    20.04.2019 10:45:48
    Helmut
    Guten Morgen Nepumuk
    entschuldige, dass ich mich erst heute melde, hatte gestern frei. Ich habe jetzt einmal eine Beispieldatei hochgeladen. Im TB Leiter-Kontrollblatt in Zelle C 51 (Zellname: „Bemerkung“) wird etwas eingetragen; jetzt soll im TB Datenbank im Bereich N4:Q302 (Zellname: „BemerktAlle“) die Formel gegen den Text aus der Zelle „Bemerkung“ ausgetauscht werden.
    Da das Blatt sehr kompliziert aufgebaut ist, habe ich es so eingestellt, dass sich die Formel/Text im TB Datenbank Zeile 4/Spalte 14 (N) ändern sollte. Ich kann mir ja den Bereich anschließend selbst anpassen solltest du eine Lösung finden. Wie gesagt, das tut es aber nicht.
    Recht recht herzlichen Dank für deine Hilfe.
    https://www.herber.de/bbs/user/129280.xlsm
    Anzeige
    AW: Ereignis hizufügen
    20.04.2019 13:58:19
    Nepumuk
    Hallo Helmut,
    immer noch an deinem Leiterprotokoll ;-)
    Teste mal:
    Private Sub Worksheet_Calculate()
        ' Löscht die Formel im definierten Bereich und ersetzt sie gegen den
        ' Text "Wahr" der durch die Berechnung der Formeln entstanden ist (Datenbank)
        Dim objCell As Range, objRange As Range
        On Error Resume Next
        Set objRange = Range("DB,Zähler,BemerkAlle").SpecialCells(Type:=xlCellTypeFormulas, Value:=xlTextValues)
        On Error GoTo 0
        If Not objRange Is Nothing Then
            Application.Calculation = xlCalculationManual
            For Each objCell In objRange
                objCell.Value = objCell.Value
            Next
            Application.Calculation = xlCalculationAutomatic
        End If
    End Sub

    Gruß
    Nepumuk
    Anzeige
    Noch nicht ganz
    20.04.2019 20:27:34
    Helmut
    Guten Abend Nepumuk
    Jaja das liebe Leitern Kontrollblatt :), ich habe jetzt den Code ausprobiert, jetzt wird mir zwar „BemerkAlle" die Formel gegen den Text ausgetauscht, jedoch nicht mehr bei Bereich „DB“.
    Was läuft hier schief?
    Besten Dank im Voraus, LG Helmut
    AW: Noch nicht ganz
    20.04.2019 21:02:53
    Nepumuk
    Hallo Helmut,
    so besser?
    Private Sub Worksheet_Calculate()
        ' Löscht die Formel im definierten Bereich und ersetzt sie gegen den
        ' Text "Wahr" der durch die Berechnung der Formeln entstanden ist (Datenbank)
        Dim objCell As Range, objRange As Range
        On Error Resume Next
        Set objRange = Range("DB,Zähler").SpecialCells(Type:=xlCellTypeFormulas, Value:=xlLogical)
        On Error GoTo 0
        If Not objRange Is Nothing Then
            Application.Calculation = xlCalculationManual
            For Each objCell In objRange
                With objCell
                    If .Value Then .Value = .Value
                End With
            Next
            Application.Calculation = xlCalculationAutomatic
        End If
        On Error Resume Next
        Set objRange = Range("BemerkAlle").SpecialCells(Type:=xlCellTypeFormulas, Value:=xlTextValues)
        On Error GoTo 0
        If Not objRange Is Nothing Then
            Application.Calculation = xlCalculationManual
            For Each objCell In objRange
                With objCell
                    .Value = .Value
                End With
            Next
            Application.Calculation = xlCalculationAutomatic
        End If
    End Sub

    Gruß
    Nepumuk
    Anzeige
    Leider Nein
    21.04.2019 12:01:48
    Helmut
    Servus Nepumuk
    Leider Nein! Es Werden im Bereich "DB" sofort alle Formeln gegen den text ersetzt (das sind ein paar 100).
    Hilfe!!! Im Bereich "BermerkAlle" funktioniert es jedoch.
    LG Helmut
    AW: Leider Nein
    21.04.2019 13:25:31
    Nepumuk
    Hallo Helmut,
    es hat ein bisschen gedauert bis ich meinen Fehler gefunden habe. Ich bin fälschlicherweise davon ausgegangen wenn im 2. Set objRange = Range("BemerkAlle")… keine Zelle gefunden wird, dass das Range-Objekt den Wert Nothing erhält. Dem ist aber nicht so. Es enthält die im 1. Set gefundenen Zellen.
    Also:
    Option Explicit

    Private Sub BemerkungenLöschen_Click()
        ' Löscht alle "Ergebnisse" und ersetzt sie wieder gegen die Formel
        If MsgBox(Prompt:=" Sind Sie sicher, das Sie alle Bemerkungen engültig löschen wollen?", _
            Buttons:=vbYesNo, Title:="Überprüfungen löschen!") = vbYes Then
            
            'in diesen Zellen sind die Formeln hinterlegt, die in dem Bereich ("") _
                'wieder eingefügt werden(Zeile ist jedoch ausgeblendet)
            Range("VorlageBemerk").AutoFill Destination:=Range("BemerkAlle")
        End If
    End Sub

    Private Sub Worksheet_Calculate()
        ' Löscht die Formel im definierten Bereich und ersetzt sie gegen den
        ' Text "Wahr" der durch die Berechnung der Formeln entstanden ist (Datenbank)
        Dim objCell As Range, objRange As Range
        On Error Resume Next
        Set objRange = Range("DB,Zähler").SpecialCells(Type:=xlCellTypeFormulas, Value:=xlLogical)
        On Error GoTo 0
        If Not objRange Is Nothing Then
            For Each objCell In objRange
                With objCell
                    If .Value Then .Value = .Value
                End With
            Next
        End If
        Set objRange = Nothing
        On Error Resume Next
        Set objRange = Range("BemerkAlle").SpecialCells(Type:=xlCellTypeFormulas, Value:=xlTextValues)
        On Error GoTo 0
        If Not objRange Is Nothing Then
            For Each objCell In objRange
                With objCell
                    .Value = .Value
                End With
            Next
        End If
    End Sub

    Gruß
    Nepumuk (und noch einen schönen Ostersonntag)
    Anzeige
    Alles bestens
    21.04.2019 18:46:00
    Helmut
    Guten Abend Nepumuk
    Alles bestens! Wie nicht anders zu erwarten, wenn du etwas in die Hand nimmst dann funktioniert es auch bin sehr sehr stolz auf dich. Herzlichen Dank. Nächsten Monat geht es los mit meinem Leitern überprüfen! Nochmals recht herzlichen Dank, LG Helmut
    frohe Ostern!

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige