Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon DaveB vom 15.10.2021, 09:51 Options

Benötige Hilfe für eine bedingte Formatierung mit VBA

Hallo Liebe Forumsmitglieder,
habe mir hier schon viel Hilfe im Forum holen können, aber dieses Mal komm ich irgendwie nicht weiter.
Ausgangslage
Tabellenblatt 1: (Planungsliste)
Übersicht aller Positionen von denen Tabellenblätter vorhanden sind, insgesamt 31 Zeilen. In Spalte S in der Übersicht Soll ein orangener Punkt angezeigt werden (Arial Schriftgröße: 100 Punkte, Farbe Orange) Wenn hinten im Tabellenblatt zur zugehörigen Zeile im DropDown Menü "Ja" ausgewählt wird. Soweit kein Problem über eine Wenn Funktion

=WENN(leer1!Y$7=2;"kein O-Punkt erteilt!";"•")

Jedoch wird mir nun wenn ich imDrop Down Menü "nein" auswähle, "kein O-Punkt erteilt!" auch in Orange und Schriftgröße 100 angezeigt, das soll aber in Schriftgröße 8 und in schwarz erfolgen.

Hier beginnt nun das eigentliche Problem.
Hat jemand ne Idee wie das Makro aussehen muss, damit ich das in Spalte S welche über das DropDown Menü automatisch befüllt wird, damit entweder der Punkt oder der Text richtig angezeigt wird? Wichtig: Die Spalte S ist auch über einen Blattschutz gegen Eingaben gesperrt.

Komme hier leider nicht weiter und es ist sehr dringend!

Vielen Dank im Voraus für Eure Hilfe

David

Antwort schreiben

Antwort 1 von fedjo vom 15.10.2021, 10:40 Options

Hallo David,
vielleicht kannst du ja eine Musterdatei ins Forum stellen.

http://www.file-upload.net/

Gruß
fedjo

Antwort 2 von DaveB vom 15.10.2021, 12:48 Options

Hallo fedjo,
würde ich gerne machen, jedoch unterliegt die Datei der Geheimhaltung.
Somit kann ich sie nicht anhängen.

Gruß David

Antwort 3 von Hajo_Zi vom 15.10.2021, 13:24 Options

Hallo Dave,

vielleicht ist die Seite ein Ansatz bedingte Formatierung per VBA

Gruß Hajo

Antwort 4 von DaveB vom 15.10.2021, 13:30 Options

Hallo Hajom
die Datei ist etwas unübersichtlich, und als VBA Anfänger komm ich damit warscheinlich nicht zurecht...

Danke trotzdem!

Antwort 5 von malSchauen vom 15.10.2021, 14:22 Options

Hi,

Dann mal angepasst an Deine Wünsche, so wie ich sie verstanden habe:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngZelle As Range
  Me.Unprotect Password:="DeinPasswort"   'BlattSchutz aufheben
  For Each rngZelle In Range("S1:S31")    'für jede Zelle im Bereich S1:S31
    If rngZelle.Value = "•" Then            'wenn der Inhalt "•"
      With rngZelle.Font                      'mit den Schrifteigenschaften dieser Zelle
        .ColorIndex = 44                        'Farbe Orange
        .name = "Arial"                         'Schrift "Arial"
        .Size = 100                             'Größe 100
      End With                                'MIT-Ende
    Else                                    'anderer Inhalt als ein "•"
      With rngZelle.Font
        .ColorIndex = xlAutomatic               'Farbe auf Auto (=1 wäre Schwarz)
        .Size = 8                               'Größe 8
        .name = "Arial"                         'Schrift "Arial
      End With
    End If
  Next
  Me.Protect Password:="DeinPasswort"     'Blattschutz einschalten
End Sub

Kopiere diesen Code im VBA-Editor in das Projekt Deiner Tabelle (Planungsliste). Eine bebilderte Anleitung dazu finder Du auf der Seite des SN-Members coros in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 2 . Testen würde ich es an Deiner Stelle dann zuerst in einer zuvor angelegten (Sicherheits-) Kopie der Originaldatei.

Ist der Blattschutz ohne Passwort angelegt, entferne die Anweisungen Password:="DeinPasswort" aus dem Code. Andernfalls trage zwischen den "" Dein wirkliches Passwort ein.

bye
malSchauen

Antwort 6 von DaveB vom 15.10.2021, 14:37 Options

Hallo mal schauen,
das makro funktioniert soweit wunderbar! Nur gibt es ein Problem! Das DropDown Menü gibt ne 1 oder ne 2 zurück. Welches ich für die Wenn Funktion brauche!

=WENN(leer1!Y$7=2;"kein O-Punkt erteilt!";"•")
Ich weiß nicht woran es liegt, wenn ich 1 oder 2 direkt in die Zelle eintrage, und ENTER drücke, funktioniert alles bestens, wenn ich jedoch über das DropDown Menü das mache, ändert sich der Zellinhalt aber nicht die Formatierung!

Weist Du noch einen Rat?

Grüße
David

Antwort 7 von DaveB vom 15.10.2021, 14:53 Options

Hallo malSchauen,

kann es sein das es dran liegt, das ich auf zwei verschiedenen Tabellenblättern arbeite?

Gruß David

Antwort 8 von malSchauen vom 15.10.2021, 15:15 Options

Hi,

Hmmm... Bei dieser Konstellation wird das Worksheet_Change-Ereignis überhaupt nicht ausgelöst. Das wusste ich so auch noch nicht. Ändere mal die erste Zeile des Codes aus AW5 von:

Private Sub Worksheet_Change(ByVal Target As Range)

Private Sub Worksheet_Calculate()

Dann sollte passen.

bye
malSchauen

Antwort 9 von DaveB vom 15.10.2021, 15:35 Options

Hallo malSchauen,

Vielen Vielen Dank für deine Hilfe!

Jetzt funktioniert es perfekt!!!

Danke!

Gruß David

Antwort 10 von DaveB vom 15.10.2021, 15:57 Options

Hallo malSchauen,
eine Frage hätte ich noch, wenn ich jetzt in einem meinen hinteren Blättern was eingebe und Enter drücke, springt er ganz kurz wieder auf die Planungsliste und wieder zurück. Das geschieht innerhalb von wenigen millisekunden.
Ist zwar schöner Wohnen, aber gibts da irgend eine Abhilfe?

Grüße David

Antwort 11 von malSchauen vom 15.10.2021, 16:56 Options

Hi,

Das muss irgendwie wie dem Tabellenschutz zusammen hängen. (Wieder was neues für mich.) Da ich das hier ohne .Protect habe laufen lassen, ist es mir nat. nicht aufgefallen. Jetzt mit dem Code (wie oben gepostet) im Calculate-Ereignis, bringe ich unter Umständen die ganze Mappe zum Stillstand. Nehmen wir also Activate-Ereignis der Tabelle. Nachteil dabei: Du wirst kurz die Tabelle, wenn Du auf sie wechselst, mit der "falschen" Formatierung sehen. malSchauen, ob Du damit dann so leben kannst.

Entferne allen bisher geposteten Code aus der Tabelle und füge folgenden ein:

Private Sub Worksheet_Activate()

  With Application
    .EnableEvents = False
    .ScreenUpdating = False
  End With
  
  Dim rngZelle As Range
  
    Me.Unprotect Password:="DeinPasswort"   'BlattSchutz aufheben
    For Each rngZelle In Range("A1:A31")    'für jede Zelle im Bereich S1:S31
      If rngZelle.Value = "•" Then            'wenn der Inhalt "•"
        With rngZelle.Font                      'mit den Schrifteigenschaften dieser Zelle
          .ColorIndex = 44                        'Farbe Orange
          .name = "Arial"                         'Schrift "Arial"
          .Size = 100                             'Größe 100
        End With                                'MIT-Ende
      Else                                    'anderer Inhalt als ein "•"
        With rngZelle.Font
          .ColorIndex = xlAutomatic               'Farbe auf Auto (=1 wäre Schwarz)
          .Size = 8                               'Größe 8
          .name = "Arial"                         'Schrift "Arial
        End With
      End If
    Next
   Me.Protect Password:="DeinPasswort"      'Blattschutz einschalten
   
  With Application
    .EnableEvents = True
    .ScreenUpdating = True
  End With

End Sub

Etwas anderes will mir da leider nicht einfallen.

bye
malSchauen

Antwort 12 von DaveB vom 16.10.2021, 07:51 Options

Hall malSchauen,
das VBA ist perfekt. Jetzt passt wirklich alles.
Jedoch habe ich jetzt noch ne zweite Frage.

In meinen Eingabeblättern habe ja insgesamt 31 vergebe ich automatisch einen Namen für das Tabellenblatt über folgendes VBA, welches im Blatt steht, wenn man mit Rechtsklick auf den Reiter klickt:


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) <> "K2" Then Exit Sub

On Error Resume Next
Me.Name = Target.Value
If Err.Number <> 0 Then
MsgBox "Der Blatname '" & Target.Value & "' ist ungültig!", vbExclamation
End If
End Sub

Diesen Namen finde ich auch vorne auf meiner Liste wiederda er aus dem gleichen Feld "K2" verlinkt ist. Beim eingeben der Daten, habe ich nun das Problem, da es sich um Nummern und keine Namen habndelt, das die einzelnen Tabellenblätter nur noch schwer auffindbar sind.
Da habe ich gedacht, ich lege den Namen in der Liste einfach als Hyperlink an funktioniert auch gut, genau so lange bis sich hinten der Blattname ändert. Zum Beispiel von "Leer13" auf "A839-542" wer Name des Hyperlinks ändert sich zwar mit, jedoch fehlt der Bezug zum entsprechende Tabellenblatt.

Fehlermeldung: Bezug fehlt!

Kann man hier Abhilfe schaffen?

Wenn ja wie? Hast Du eine Idee?

Grüße David

Antwort 13 von malSchauen vom 16.10.2021, 13:43 Options

Hi,

Da würde ich nicht mit Hyperlinks arbeiten wollen.

Zum einen würde ich das Makro aus A12 modifizieren wollen. Warum? Ich möchte sicherstellen, dass in K2 immer der jeweilige Blattname steht. Auch wenn direkt nach dem Bestätigen der MsgBox das Tel. klingelt. ;-) Dann kann es auch "Vorne"? in der Liste keinen Eintrag geben, der einen falschen Bezug darstellt. Mein Ansatz sieht dafür aus wie folgt:

If Target.Address(0, 0) = "K2" Then
  On Error Resume Next
  Me.name = Target.Value
  If Err.Number <> 0 Then
    MsgBox "Der Blattname '" & Target.Value & "' ist ungültig!", vbExclamation
    Target.Value = ActiveSheet.name
    Target.Activate
  End If
End If

Dann würde ich die Hyperlinks löschen wollen, um im SelectionChange-Ereignis der Liste "vorne" folgenden Code zu platzieren:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Range(Target.Address), Range("A1:A31")) Is Nothing _
      And Target.Count = 1 Then
    'um zweimal hintereinander das selbe Blatt wählen zu können
    'Nachbarzelle selektieren
    Range(Target.Address).Offset(0, 1).Select
    ThisWorkbook.Sheets(CStr(Target.Value)).Select
  End If
End Sub

Der Bereich muss nat. angepasst werden (hier A1:A31).
Wenn es denn Hyperlinks sein müssen, könnte man evtl. im SheetActivate-Ereignis die Links jeweils neu schreiben (wie oben bei der Formatiererei).

bye
malSchauen

Antwort 14 von DaveB vom 16.10.2021, 14:03 Options

Hallo malSchauen,
das funktioniert ja perfekt. Echt eine elitäre Lösung!!!

Vielen Dank und ein schönes Wochenende.

Grüße
David

Antwort 15 von DaveB vom 05.11.2021, 15:35 Options

Hallo malSchauen,
ich weiß es ist schon eine Weile her, jedoch bin ich fast am verzweifeln, wie muss Dein Code aussehen, damit ich die Planungsliste sortieren kann per Autofilter? Habe es versucht bekomme es nicht hin.


Private Sub Worksheet_Activate()

  With Application
    .EnableEvents = False
    .ScreenUpdating = False
  End With
  
  Dim rngZelle As Range
  
  Worksheets("Planungsliste").Protect Password:="test", userinterfaceonly:=True
    For Each rngZelle In Range("R1:R37")    'für jede Zelle im Bereich R1:R37
      If rngZelle.Value = "•" Then            'wenn der Inhalt "•"
        With rngZelle.Font                      'mit den Schrifteigenschaften dieser Zelle
          .ColorIndex = 45                        'Farbe Orange
          .Name = "Arial"                         'Schrift "Arial"
          .Size = 100                             'Größe 100
        End With                                'MIT-Ende
      Else                                    'anderer Inhalt als ein "•"
        With rngZelle.Font
          .ColorIndex = xlAutomatic               'Farbe auf Auto (=1 wäre Schwarz)
          .Size = 8                               'Größe 8
          .Name = "Arial"                         'Schrift "Arial
        End With
      End If
    Next
   Worksheets("Planungsliste").Protect "test", DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True

   
  With Application
    .EnableEvents = True
    .ScreenUpdating = True
  End With

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Range(Target.Address), Range("c5:c37")) Is Nothing _
      And Target.Count = 1 Then
    'um zweimal hintereinander das selbe Blatt wählen zu können
    'Nachbarzelle selektieren
    Range(Target.Address).Offset(0, 1).Select
    ThisWorkbook.Sheets(CStr(Target.Value)).Select
  End If
End Sub

Kannst Du mir nochmal helfen?

Wenn ich Datei öffne, lässt sie sich noch sortieren, erst wenn ich auf ein anderes Tabellenblatt springe und wieder zurück auf die Planungsliste springe lässt sie sich nicht mehr sortieren. Autofilter und Zellformatierung funktionieren aber immer noch.

Was stimmt da nicht?

Vielen Dank im Voraus!

Grüße
David

Antwort 16 von malSchauen vom 06.11.2021, 20:51 Options

Hi,

Ich kann Dir leider nicht ganz folgen, wo genau Dein Problem liegt. Reagiert etwas nicht? Gibt es Fehlermeldungen? Was soll wo, wann, wie sortiert werden? (eine BeispielDatei wäre in diesem Fall wohl das Beste)

So aus dem Stand gehe ich einmal davon aus, dass Du eine Fehlermeldung erhälst die besagt, dass Du geschützte Zellen ändern willst, was ohne Aufhebung des Schutzes so nicht möglich sei. Da Du die Tabelle("Planungsliste") im Makro ja mit eben diesem Schutz versiehst, liegt das für mich am nächsten. Da hilft auch der Parameter AllowSorting:=True nicht wirklich. So Du dazu in der Entwicklerhilfe nachliest findest Du folgendes:

Zitat:
Mit True können Benutzer für das geschützte Arbeitsblatt eine Sortierung vornehmen. Für jede Zelle im Sortierbereich muss die Sperre oder der Schutz aufgehoben werden. Der Standardwert ist False

Hebe doch spasseshalber den Tabellenschutz für "Planungsliste" auf, kommentiere in Deinem Makro die beiden Zeilen mit der .Protect-Methode aus. Hast Du dann immernoch das Problem?

bye
malSchauen

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..

Neue Einträge

Tipp einschicken

News einschicken