Office: (Office 2010) Makro Modifizierung

Helfe beim Thema Makro Modifizierung in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo Leute, ich brauch mal wieder Eure Hilfe. Ich will folgendes funktionierendes Makro erweitern. Private Sub Worksheet_Change(ByVal Target... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von herma, 3. Januar 2019.

  1. herma hat Ahnung

    Makro Modifizierung


    Hallo Leute,

    ich brauch mal wieder Eure Hilfe. Ich will folgendes funktionierendes Makro erweitern.

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B2:B540, G2:G540, I2:I540, K2:K540, M2:M540, O2:O540, Q2:Q540")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
    If Target = "" Then
    Target.Offset(0, 1).ClearContents
    Else:
    Target.Offset(0, 1) = Date$
    End If
    Dim rngZelle As Range
    If Target.Cells(1).Value = "x" Then
    Application.EnableEvents = False
    For Each rngZelle In Target
    rngZelle.Value = "abgeschlossen"
    rngZelle.Interior.ColorIndex = 4
    Target.Font.ColorIndex = 1
    Cells(rngZelle.Row, 1).Interior.ColorIndex = 4
    Next rngZelle
    Application.EnableEvents = True
    End If
    If Target.Cells(1).Value = "w" Then
    Application.EnableEvents = False
    For Each rngZelle In Target
    rngZelle.Value = ""
    rngZelle.Interior.ColorIndex = 2
    Target.Font.ColorIndex = 1
    Cells(rngZelle.Row, 1).Interior.ColorIndex = 2
    Next rngZelle
    Application.EnableEvents = True
    End If

    End Sub



    Und zwar soll folgende Funktion: Cells(rngZelle.Row, 1).Interior.ColorIndex = 4 nur eintreten wenn in der Zeile die Spalte B und eine der anderen Spalten mit einem X als abgeschlossen gekennzeichnet wurden. Also in jeder Spalte für sich bleibt es bei der Veränderung durch ein X. Nur soll die erste Spalte nur Grün werden wenn in zwei Spalten (B und einer anderen) ein x steht.
    Ich hoffe das ist einigermaßen verständlich und ich bitte um eure Hilfe.

    Vielen Dank schon mal für Eure Bemühungen.
     
  2. Beverly
    Beverly Erfahrener User
    Hi,

    weshalb benutzt du nicht die bedingte Formatierung anstelle VBA?

    Ersetzt deine Zeile Cells(rngZelle.Row, 1).Interior.ColorIndex = 4 durch diesen Code:

    Code:
        Dim rngBereich As Range
        Dim rngZelle As Range
        Dim intZaehler As Integer
        Set rngBereich = Union(Cells(Target.Row, 7), Cells(Target.Row, 9), Cells(Target.Row, 11), Cells(Target.Row, 13), Cells(Target.Row, 15), Cells(Target.Row, 17))
        If Cells(Target.Row, 2) = "x" Then
            For Each rngZelle In rngBereich
                If rngZelle.Value = "x" Then intZaehler = intZaehler + 1
            Next rngZelle
            If intZaehler > 0 Then Cells(Target.Row, 1).Interior.ColorIndex = 4
        End If
    
    
    Bis später,
    Karin

    Bis später,
    Karin
     
    Beverly, 3. Januar 2019
    #2
  3. herma hat Ahnung
    Hallo Karin,

    vielen Dank für deine Bemühungen und deine Hilfe. Leider funktioniert es bei mir nicht. Wenn ich deinen Code für die Zeile einsetze meckert Excel über eine Doppeltnennung von "Dim rngBereich as Range" und wenn ich es dann einmal streiche passiert nichts mehr in meinem Code.

    Viele Grüße
    Jonas
     
  4. Beverly
    Beverly Erfahrener User

    Makro Modifizierung

    Hi Jonas,

    da dein Code (im Gegensatz zu meinem) unstrukturiert und deshalb unleserlich und damit schwer verständlich ist, habe ich übersehen, dass du bereits eine Variable rngZelle (nicht rngBereich!!!) benutzt - ändere in meinem Code rngZelle in rngZelle2.
    Außerdem solltest du generell alle Variablendeklarationen (also auch meine) an den Anfang der Prozedur stellen - dann wäre diese Doppelbenennung gleich ins Auge gefallen...

    Ich habe mir jetzt mal die Mühe gemacht, deinen Code in eine Beispielmappe einzufügen und zu testen - bei dir wird ein eingetragenes "x" in das Wort "abgeschlossen" umgewandelt, also ist deine Aussage:

    wenn in der Zeile die Spalte B und eine der anderen Spalten mit einem X als abgeschlossen gekennzeichnet wurden.

    falsch, denn nicht "x" steht in der Zelle sondern "abgeschlossen". Es darf also nicht nach "x" gesucht werden sondern du musst in meinem Code "x" durch "abgeschlossen" ersetzen.

    Bis später,
    Karin
     
    Beverly, 4. Januar 2019
    #4
  5. herma hat Ahnung
    Hallo Karin,

    ich bin dir sehr dankbar für deine Hilfe, da ich in diesem Thema nicht so fit bin. Ich habe diesen Code auch mit Hilfe des Forums entwickelt und bin froh, dass er so funktioniert hat.
    Ich habe nun alles versucht so zu ändern, wie du gesagt hast und bekomme nun leider die Fehlermeldung "For-Steuervariable" wird bereits verwendet.

    VG
    Jonas
     
  6. herma hat Ahnung
    Hallo Karin,

    vielen Dank ich habe nun eine Sache nun geändert und nun funktioniert es auch bei mir. Vielen vielen Dank für deine Hilfe.

    Viele Grüße
    Jonas
     
  7. Beverly
    Beverly Erfahrener User
    Hi Jonas,

    ich nehme an, du hattest in der Zeile Next rngZelle2 in meinem Code die 2 vergessen zu ergänzen?

    Bis später,
    Karin
     
    Beverly, 4. Januar 2019
    #7
  8. herma hat Ahnung

    Makro Modifizierung

    Genau :)
     
  9. Beverly
    Beverly Erfahrener User
    Nur ein Hinweis für die Zukunft: wenn man etwas ändert, das dann zur Lösung eines Problems führt, sollte man hier auch posten WAS man geändert hat, damit andere User ebenfalls davon profitieren können. ;)

    Bis später,
    Karin
     
    Beverly, 4. Januar 2019
    #9
  10. herma hat Ahnung
    Hallo Karin, Hallo Freunde,

    vielleicht kann mir einer bei einer kleinen Modifikation helfen. Die erste Spalte soll nur grün werden wenn in Spalte B "abgeschlossen erscheint UND in Spalte H/J/L/N/P/R ein zweites "abgeschlossen" erscheint. Momentan ist mir aufgefallen wird Spalte A auch grün wenn nur Spalte B "abgeschlossen" ist.

    Der Einfachheithalber hier nochmal der aktuelle Code:

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B2:B540, H2:H540, J2:J540, L2:L540, N2:N540, P2:P540, R2:R540")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
    If Target = "" Then
    Target.Offset(0, 1).ClearContents
    Else:
    Target.Offset(0, 1) = Date$
    End If
    Dim rngZelle As Range

    If Target.Cells(1).Value = "x" Then
    Application.EnableEvents = False
    For Each rngZelle In Target
    rngZelle.Value = "abgeschlossen"
    rngZelle.Interior.ColorIndex = 4
    Target.Font.ColorIndex = 1
    Dim rngBereich As Range
    Dim rngZelle2 As Range
    Dim intZaehler As Integer
    Set rngBereich = Union(Cells(Target.Row, 2), Cells(Target.Row, 8), Cells(Target.Row, 10), Cells(Target.Row, 12), Cells(Target.Row, 14), Cells(Target.Row, 16), Cells(Target.Row, 18))
    If Cells(Target.Row, 2) = "abgeschlossen" Then
    For Each rngZelle2 In rngBereich
    If rngZelle.Value = "abgeschlossen" Then intZaehler = intZaehler + 1
    Next rngZelle2
    If intZaehler > 0 Then Cells(Target.Row, 1).Interior.ColorIndex = 4
    End If
    Next rngZelle
    Application.EnableEvents = True
    End If
    If Target.Cells(1).Value = "w" Then
    Application.EnableEvents = False
    For Each rngZelle In Target
    rngZelle.Value = ""
    rngZelle.Interior.ColorIndex = 2
    Target.Font.ColorIndex = 1
    Cells(rngZelle.Row, 1).Interior.ColorIndex = 2
    Next rngZelle
    Application.EnableEvents = True
    End If

    End Sub


    Ich habe es probiert aber finde selber einfach keine Lösung. Wäre super wenn einer mir helfen kann. Vielen Dank an Euch
     
  11. Beverly
    Beverly Erfahrener User
    Ist ja auch kein Wunder, denn du hast die Zeilen

    Code:
    [TABLE="width: 88"]
    <tbody>[TR]
    [TD="width: 88"]rngZelle.Value =   "abgeschlossen"[/TD]
    [/TR]
    [TR]
    [TD]rngZelle.Interior.ColorIndex = 4[/TD]
    [/TR]
    </tbody>[/TABLE]
    
    mit denen das "x" durch "abgeschlossen" ersetzt und anschlließend die Zelle grün gefärbt wird - also auch wenn du in Spalte A etwas einträgst. Entweder du lässt die 2. Zeile ganz weg, falls die Farbe nicht auch in den Spalten B, H, J usw. geändert werden soll, denn Spalte A wird ja in dem von mir geposteten Code gefärbt, falls noch in einer anderen Spalte "abgeschlossen" steht. Oder falls auch in den anderen Spalte gefärbt werden soll, dann schreibst du stattdessen:

    Code:
    If rngZelle.Column <> 1 Then rngZelle.Interior.ColorIndex = 4
    
    
    Es wird also geprüft ob rngZelle in Spalte A ausgeführt wird und die Farbe wird nur gesetzt falls nicht Spalte A.

    Bis später,
    Karin
     
    Beverly, 1. Februar 2019
    #11
  12. herma hat Ahnung
    Hallo Karin,

    In Spalte A wird nie etwas manuell eingetragen. Diese Spalte (bzw. eine Zelle) soll nur grün werden wenn in einer Zeile zweimal abgeschlossen erscheint. Also ich setze z.B. in Zeile 1 in Spalte B und in Spalte H ein abgeschlossen. Erst dann soll die Zelle in Spalte A grün werden. Nur ein abgeschlossen in Spalte B soll nicht dazu führen, dass Spalte A grün wird.

    Viele Grüße
    Jonas
     
  13. Beverly
    Beverly Erfahrener User

    Makro Modifizierung

    Hi Jonas,

    dann so:

    Code:
        Dim rngBereich As Range
        Dim rngZelle As Range
        Dim intZaehler As Integer
        Set rngBereich = Union(Cells(Target.Row, 2), Cells(Target.Row, 8), Cells(Target.Row, 10), Cells(Target.Row, 12), Cells(Target.Row, 14), Cells(Target.Row, 16), Cells(Target.Row, 18))
        For Each rngZelle In rngBereich
            If rngZelle = "abgeschlossen" Then intZaehler = intZaehler + 1
            If intZaehler = 2 Then
                Cells(Target.Row, 1).Interior.ColorIndex = 4
                Exit For
            End If
        Next rngZelle
    
    Bis später,
    Karin
     
    Beverly, 4. Februar 2019
    #13
  14. herma hat Ahnung
    Hallo Karin,

    ich probiere die ganze Zeit es einzubinden und verstehe sogar die Logik des Codes :) aber ich kriege es dennoch nicht zum laufen.

    So schaut der gesamte Code nun aus. Aber momentan passiert bei einem "X" gar nichts mehr....

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B2:B540, H2:H540, J2:J540, L2:L540, N2:N540, P2:P540, R2:R540")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
    If Target = "" Then
    Target.Offset(0, 1).ClearContents
    Else:
    Target.Offset(0, 1) = Date$
    End If
    Dim rngZelle As Range

    If Target.Cells(1).Value = "x" Then
    Application.EnableEvents = False
    For Each rngZelle In Target
    rngZelle.Value = "abgeschlossen"
    rngZelle.Interior.ColorIndex = 4
    Target.Font.ColorIndex = 1
    Dim rngBereich As Range
    Dim intZaehler As Integer
    Set rngBereich = Union(Cells(Target.Row, 8), Cells(Target.Row, 10), Cells(Target.Row, 12), Cells(Target.Row, 14), Cells(Target.Row, 16), Cells(Target.Row, 18))
    For Each rngZelle In rngBereich
    If rngZelle = "abgeschlossen" Then intZaehler = intZaehler + 1
    If intZaehler = 2 Then
    Cells(Target.Row, 1).Interior.ColorIndex = 4
    Exit For
    End If
    Next rngZelle
    Application.EnableEvents = True
    End If
    If Target.Cells(1).Value = "w" Then
    Application.EnableEvents = False
    For Each rngZelle In Target
    rngZelle.Value = ""
    rngZelle.Interior.ColorIndex = 2
    Target.Font.ColorIndex = 1
    Cells(rngZelle.Row, 1).Interior.ColorIndex = 2
    Next rngZelle
    Application.EnableEvents = True
    End If

    End Sub


    Bis Später
    Jonas
     
  15. Beverly
    Beverly Erfahrener User
    Hi Jonas,

    ich würde denken so, kann es jedoch nicht testen da ich 1. deine Mappe nicht kenne und mir 2. auch nicht klar ist, was bei dir wann genau pasieren soll

    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rngZelle As Range
        Dim rngBereich As Range
        Dim intZaehler As Integer
        If Intersect(Target, Range("B2:B540, H2:H540, J2:J540, L2:L540, N2:N540, P2:P540, R2:R540")) Is Nothing Then Exit Sub
        If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
        If Target = "" Then
            Target.Offset(0, 1).ClearContents
        Else:
            Target.Offset(0, 1) = Date$
        End If
        Set rngBereich = Union(Cells(Target.Row, 2), Cells(Target.Row, 8), Cells(Target.Row, 10), Cells(Target.Row, 12), Cells(Target.Row, 14), Cells(Target.Row, 16), Cells(Target.Row, 18))
        If Target.Cells(1).Value = "x" Then
            Application.EnableEvents = False
            For Each rngZelle In Target
                rngZelle.Value = "abgeschlossen"
            Next rngZelle
            For Each rngZelle In rngBereich
                If rngZelle = "abgeschlossen" Then intZaehler = intZaehler + 1
                If intZaehler = 2 Then
                    Cells(Target.Row, 1).Interior.ColorIndex = 4
                    Exit For
                End If
            Next rngZelle
            Application.EnableEvents = True
        ElseIf Target.Cells(1).Value = "w" Then
            Application.EnableEvents = False
            Target.Value = ""
            Target.Interior.ColorIndex = 2
            Target.Font.ColorIndex = 1
            Cells(Target.Row, 1).Interior.ColorIndex = 2
            Application.EnableEvents = True
        End If
    End Sub
    
    

    Soll die Farbe tatsächlich auf Weiß gesetzt werden oder soll sie einfach zurückgesetzt werden auf keine Farbe wenn "w" eingegeben wird? Falls die Farbe zurück auf keine Farbe gesetzt werden soll, dann musst du anstelle = 2 schreiben = xlNone

    Bis später,
    Karin
     
    Beverly, 4. Februar 2019
    #15
Thema:

Makro Modifizierung

Die Seite wird geladen...
  1. Makro Modifizierung - Similar Threads - Makro Modifizierung

  2. Zeitstempel aus Stoppuhr bei Notizen

    in Microsoft Word Hilfe
    Zeitstempel aus Stoppuhr bei Notizen: Moin, lange gesucht und nichts gefunden, deshalb hier der Versuch: Ich will bei meinen Notizen einen Zeitstempel haben, der sich nicht an der eigentlich Zeit orintiert, sondern an einer Stoppuhr....
  3. Makro für Hintergrundfarben

    in Microsoft Word Hilfe
    Makro für Hintergrundfarben: Hi, Ich konnte Makros für Textfarben erstellen, damit ich vorgefertigte Farb-Icons im Menü habe. z.B. Sub fontRed() Selection.Font.ColorIndex = wdRed End Sub weiss jemand ob das auch mit...
  4. VBA Makro abbrechen durch Inputbox

    in Microsoft Word Hilfe
    VBA Makro abbrechen durch Inputbox: Hallo zusammen, dank Gerhard H aus diesem Forum habe ich das folgende Makro im Einsatz, bei dem eine Spalte einer Tabelle in Word auf einen vom Anwender eingegebenen Begriff durchsucht wird und...
  5. Makro ändern auf Excel4Macro

    in Microsoft Excel Hilfe
    Makro ändern auf Excel4Macro: Hallo Zusammen, vor einiger Zeit hat ein Kollege von mir das unten stehende Makro geschrieben. Hier werden Dateien geöffnet und Werte ausgelesen. Leider werden die Dateien alle geöffnet und...
  6. Datenblatt per Makro benennen

    in Microsoft Excel Hilfe
    Datenblatt per Makro benennen: Grüsse zusammen, ich habe beim suchen folgendes gefunden: Tabellenblatt automatisch benennen nach Zelleninhalt Ich würde das ganze gerne nutzen, weiss nur nicht wie ich es am besten anpasse. Ich...
  7. Outlook Termineinladung an festen Kontakt

    in Microsoft Outlook Hilfe
    Outlook Termineinladung an festen Kontakt: Hallo zusammen, ich muss einen bestimmten Kontakt häufig zu einem Termin einladen und würde mir gerne ein paar Klicks sparen. Kann man eine Art Schnellsprung oder vielleicht ein Makro erstellen,...
  8. Makro - Kombination aus Zeile löschen oder Text ersetzen

    in Microsoft Excel Hilfe
    Makro - Kombination aus Zeile löschen oder Text ersetzen: Hallo miteinander, ich würde gerne folgendes Problem per Makro (nicht mit klassischen Formeln) lösen (wichtig, das Makro muss beim Öffnen starten): - wenn in Spalte A nichts steht -> gesamte...
Schlagworte:
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden