Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1008to1012
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
Inhaltsverzeichnis

Button soll Zelle prüfen ggfs. Zellbereich leeren

Button soll Zelle prüfen ggfs. Zellbereich leeren
18.09.2008 14:29:48
André
Hallo Leute,
vollgendes Problem:
Ich habe einen CommandButton, der folgendes machen soll:
***
Wenn Click, dann prüfe Wert in Zelle D6
wenn Wert = "frei"oder "krank" oder "Url", dann leere Zellen im Bereich D7:D43
wenn Wert= "früh", dann schreibe in Zelle D21:D23 "Mittag"
wenn Wert= "spät", dann schreibe in Zelle D24:D26 "Mittag"
wenn Wert= "kurz früh" dann leere Bereich D31:D43
wenn Wert= "kurz spät" dann leere Bereich D7:D18

***
Das gleiche soll dann in den Spalten E:N passieren
Dazu sei gesagt, dass alle Zellen im Bereich D7:N43 Dropdown Menüs haben, in der man Tätigkeiten auswählen kann z.B. "MA in Schulung; MA in Meeting"
Zur Erläuterung: Das Datenblatt soll auswertbar sein. Das heißt, wenn der MA nicht im Hause ist, sollen aus den Zellen keine Werte gezogen werden. Ich hatte erst mit einer bedingten Formatierung die Zellen Hintergründe und Schriften weiß gemacht, aber die Werte bleiben ja in den Zellen und verfälschen die Auswertung.
Wenn mir einer Helfen könnte wäre das super. Wenn noch Werte fehlen, dann gebt mir ein Feedback.
Ich habe aus einer anderen Datei einen VBA Code geborgt um den entsprechend umzuschreiben, aber leider bekomme ich das nicht hin. Hier ist er:

Private Sub OKAY_Click()
Dim such_Zeile As Integer
Dim TZN As Integer
Dim suchtext As String
Dim iRow As Integer
Dim kproject As String
Dim erste_freie_Zeile As Integer
Dim letzte_Daten_Zeile As Integer
Dim PW As String
PW = mal_07_einst.Range("P19").Value
mal_09_dat.Unprotect (PW)
iRow = 1
kproject = "K"
mal_07_einst.Range("P14").Value = "1"
such_Zeile = mal_07_einst.Range("P11").Value
Sheets("Daten").Cells(such_Zeile, 2) = ""
Sheets("Daten").Cells(such_Zeile, 3) = ""
Sheets("Daten").Cells(such_Zeile, 4) = ""
Sheets("Daten").Cells(such_Zeile, 5) = ""
Sheets("Daten").Cells(such_Zeile, 6) = ""
Sheets("Daten").Cells(such_Zeile, 7) = ""
Sheets("Daten").Cells(such_Zeile, 8) = ""
Sheets("Daten").Cells(such_Zeile, 9) = ""
Sheets("Daten").Cells(such_Zeile, 10) = ""
Sheets("Daten").Cells(such_Zeile, 11) = ""
Sheets("Daten").Cells(such_Zeile, 12) = ""
Sheets("Daten").Cells(such_Zeile, 13) = ""
Sheets("Daten").Cells(such_Zeile, 14) = ""
Sheets("Daten").Cells(such_Zeile, 15) = ""
Sheets("Daten").Cells(such_Zeile, 16) = ""
Sheets("Daten").Cells(such_Zeile, 17) = ""
Sheets("Daten").Cells(such_Zeile, 18) = ""
Sheets("Daten").Cells(such_Zeile, 19) = ""
Sheets("Daten").Cells(such_Zeile, 20) = ""
Sheets("Daten").Cells(such_Zeile, 21) = ""
Sheets("Daten").Cells(such_Zeile, 22) = ""
Sheets("Daten").Cells(such_Zeile, 25) = ""
Sheets("Daten").Cells(such_Zeile, 26) = ""
Sheets("Daten").Cells(such_Zeile, 27) = ""
Sheets("Daten").Cells(such_Zeile, 28) = ""
Sheets("Daten").Cells(such_Zeile, 29) = ""
pjname = 7
DZE = mal_07_einst.Range("P7").Value
DZS = 1
TZN = 0
suchtext = mal_07_einst.Range("P10").Value
If suchtext  "" Then
'Zeile suchen
For level = DZS To DZE
If mal_07_einst.Cells(level, pjname).Value = suchtext Then
TZN = level
level = DZE
End If
Next level
If TZN = 0 Then
Application.ScreenUpdating = True
to_do_suche_not.Show
Else
mal_07_einst.Range("P12").Value = TZN
Sheets("Einstellungen").Cells(TZN, 6) = ""
Sheets("Einstellungen").Cells(TZN, 7) = ""
End If
End If
Sheets("Daten").Visible = True
Sheets("Daten").Select
Range("B5:AC65536").Select
Selection.sort Key1:=Range("B5"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Einstellungen").Visible = True
Sheets("Einstellungen").Select
Range("F2:G65536").Select
Selection.sort Key1:=Range("F2"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
Sheets("Einstellungen").Select
Range("H2:I2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
letzte_Daten_Zeile = Sheets("Daten").UsedRange.SpecialCells(xlCellTypeLastCell).Row
For iRow = 1 To letzte_Daten_Zeile
If Sheets("Daten").Cells(iRow, 26).Value = kproject Then
erste_freie_Zeile = Sheets("Einstellungen").Range("H65536").End(xlUp).Offset(1, 0).Row + 1
If erste_freie_Zeile 


Danke schon mal für Eure Hilfe!!
Gruß André

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Button soll Zelle prüfen ggfs. Zellbereich leeren
18.09.2008 18:47:23
fcs
Hallo André,
ich hab jetzt keine Ahnung, was dein Beispielcode mit der beschriebenen Aufgabenstellung zu tun hat.
Der folgende Code reicht, um die Werte in Zeile 6 der Spalten D bis N zu pürfen und die zugehörigen Zellbereiche zu bearbeiten.
Den Namen des Tabellenblatts muss du entsprechend anpassen.
Evtl. muss du noch "Mittag" als zulässigen Eintrag für die Dropdown-Auswahl ergänzen, falls deine Dropdowns via Datengültigkeit angelegt sind.
gruß
Franz

Private Sub CommandButton1_Click()
Dim wks As Worksheet, lngSpalte As Long
Set wks = ActiveSheet 'oder = Worksheets("TabelllenblattName")
With wks
'Spalten D bis N abarbeiten
For lngSpalte = 4 To 14
'Eintrag in Zeile 6 der Spalten prüfen
Select Case .Cells(6, lngSpalte).Value
Case "frei", "krank", "Url"
.Range(.Cells(7, lngSpalte), .Cells(43, lngSpalte)).ClearContents
Case "früh"
.Range(.Cells(21, lngSpalte), .Cells(23, lngSpalte)).Value = "Mittag"
Case "spät"
.Range(.Cells(24, lngSpalte), .Cells(26, lngSpalte)).Value = "Mittag"
Case "kurz früh"
.Range(.Cells(31, lngSpalte), .Cells(43, lngSpalte)).ClearContents
Case "kurz spät"
.Range(.Cells(7, lngSpalte), .Cells(18, lngSpalte)).ClearContents
Case Else
'do nothing
End Select
Next
End With
End Sub


Anzeige
Noch eine bzw. zwei Fragen...
19.09.2008 12:40:01
André
Hallo Franz!
Vielen, vielen Dank!!!
Funktioniert genau so wie ich mir das vorgestellt habe!!
Zwei Fragen hätte ich aber noch.
1. Lässt sich der Code auch irgendwie einbauen, ohne dass ich einen Button drücke muss?
2. Ich möchte den Code auch für folgende Spalten benutzen: 18 - 28, 32-42, 46-56, 60-70
Wie muss ich den Code abändern, dass das klappt?
Gruß André
AW: Noch eine bzw. zwei Fragen...
19.09.2008 13:13:00
fcs
Hallo André,
falls du ohne Button arbeiten willst, dann muss du "nur" den Namen der Prozedur ändern und ggf. das Private weglassen.
Mehere Spalten-Bereiche abarbeiten ist auch kein Problem. Ich dir 2 Varianten angefügt.
Du kannst die Prozeduren auch problemlos in andere Prozeduren integrieren. Es ist aber meistens übersichtlicher, wenn man für jede etwas größere Teilaufgabe eine eigene Unter-Prozedur schreibt und diese dann von einer Hauptprozedur aus aufruft - ähnlich wie bei meiner Variante2.
Gruß
Franz

'so (Unterprogramm wird für jeden Bereich aufgerufen
Sub variante2()
'Spaltenbereich prüfen/ausfüllen
Call SpaltenPruefen(lngStartspalte:=4, lngEndspalte:=14)
Call SpaltenPruefen(lngStartspalte:=18, lngEndspalte:=28)
Call SpaltenPruefen(lngStartspalte:=32, lngEndspalte:=42)
Call SpaltenPruefen(lngStartspalte:=46, lngEndspalte:=56)
Call SpaltenPruefen(lngStartspalte:=60, lngEndspalte:=70)
End Sub
Private Sub SpaltenPruefen(lngStartspalte As Long, lngEndspalte As Long)
'Prüft Zeile 6 der Spalten und passt Zellinhalte an
Dim wks As Worksheet, lngSpalte As Long
Set wks = ActiveSheet 'oder = Worksheets("TabelllenblattName")
With wks
'Spalten abarbeiten
For lngSpalte = lngStartspalte To lngEndspalte
'Eintrag in Zeile 6 der Spalten prüfen
Select Case .Cells(6, lngSpalte).Value
Case "frei", "krank", "Url"
.Range(.Cells(7, lngSpalte), .Cells(43, lngSpalte)).ClearContents
Case "früh"
.Range(.Cells(21, lngSpalte), .Cells(23, lngSpalte)).Value = "Mittag"
Case "spät"
.Range(.Cells(24, lngSpalte), .Cells(26, lngSpalte)).Value = "Mittag"
Case "kurz früh"
.Range(.Cells(31, lngSpalte), .Cells(43, lngSpalte)).ClearContents
Case "kurz spät"
.Range(.Cells(7, lngSpalte), .Cells(18, lngSpalte)).ClearContents
Case Else
'do nothing
End Select
Next
End With
End Sub
'oder so (alle Spalten in einem Rutsch)
Sub Variante1()
Dim wks As Worksheet, lngSpalte As Long
Set wks = ActiveSheet 'oder = Worksheets("TabelllenblattName")
With wks
'Spalten D bis ... abarbeiten
For lngSpalte = 4 To 100
Select Case lngSpalte
Case 4 To 14, 18 To 28, 32 To 42, 46 To 56, 60 To 70
'Eintrag in Zeile 6 der Spalten prüfen
Select Case .Cells(6, lngSpalte).Value
Case "frei", "krank", "Url"
.Range(.Cells(7, lngSpalte), .Cells(43, lngSpalte)).ClearContents
Case "früh"
.Range(.Cells(21, lngSpalte), .Cells(23, lngSpalte)).Value = "Mittag"
Case "spät"
.Range(.Cells(24, lngSpalte), .Cells(26, lngSpalte)).Value = "Mittag"
Case "kurz früh"
.Range(.Cells(31, lngSpalte), .Cells(43, lngSpalte)).ClearContents
Case "kurz spät"
.Range(.Cells(7, lngSpalte), .Cells(18, lngSpalte)).ClearContents
Case Else
'do nothing
End Select
Case Else
'do nothing
End Select
Next
End With
End Sub


Anzeige
AW: Noch eine bzw. zwei Fragen...
19.09.2008 14:23:14
André
Hallo Franz,
kannst du mir mal für ganz Dumme sagen, wo ich ich was ändern muss, weil nach dem reinkopieren, bzw. ändern des Prozedurnamens funktioniert der Code nicht mehr.
Gibt es da nicht irgendwie ne Funktion, die automatisch prüft, wenn sich der zu kontrolierende Wert ändert?
Danke schon mal im Voraus.
Gruß André
AW: Noch eine bzw. zwei Fragen...
19.09.2008 15:43:09
fcs
Hallo André,
wenn du Änderungen von Eingabewerten im Tabellenblatt automatisch verfolgen willst, dann muss du ein sogenanntes Ereignismakro verwenden. Dieses muss du dann im VBA-Editor unter der Tabelle einfügen, in der Werte überwacht werden sollen.
Das folgende Makro startet nach Prüfung des Bereichs in dem Werte geändert wurden, die Anpassung der Werte. Hoffe das Ergebnis ist dann wie von dir gewünscht.
Gruß
Franz

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
'Prüfen, ob Wert in Zeile 6 geändert wurde
If Target.Row = 6 And Target.Rows.Count = 1 Then
With Me
'geänderte Zelle(n) in Zeile 6 prüfen
For Each Zelle In Target
Select Case Zelle.Column
'Spaltenbereiche in denen Aktionen ausgeführt werden sollen
Case 4 To 14, 18 To 28, 32 To 42, 46 To 56, 60 To 70
'Eintrag in Zeile 6 der Spalten prüfen
Select Case Zelle.Value
Case "frei", "krank", "Url"
.Range(.Cells(7, Zelle.Column), .Cells(43, Zelle.Column)).ClearContents
Case "früh"
.Range(.Cells(21, Zelle.Column), .Cells(23, Zelle.Column)).Value = "Mittag"
Case "spät"
.Range(.Cells(24, Zelle.Column), .Cells(26, Zelle.Column)).Value = "Mittag"
Case "kurz früh"
.Range(.Cells(31, Zelle.Column), .Cells(43, Zelle.Column)).ClearContents
Case "kurz spät"
.Range(.Cells(7, Zelle.Column), .Cells(18, Zelle.Column)).ClearContents
Case Else
'do nothing
End Select
Case Else
'do nothing
End Select
Next
End With
End If
End Sub


Anzeige
AW: Noch eine bzw. zwei Fragen...
22.09.2008 11:31:00
André
Hallo Franz,
vielen Danke für deine super schnelle Hilfe. Leider funktionierts nicht ganz so, wie ich mir das vorstelle.
Kurz zur Erläuterung: Die Daten in Zeile 6 zeihe ich über einen SVERWEIS aus einer anderen Tabelle. Wenn ich also in der anderen Tabelle etwas ändere, passiert erstmal gar nichts. Erst wenn ich in die Zeile 6 gehe, die Formel bearbeite und dann Enter drücke, dann funktioniert die Automatik aus dem Code.
Hast du vielleicht eine Idee, wie mans doch noch hinbekommt?
Danke & Gruß
André
AW: Noch eine bzw. zwei Fragen...
24.09.2008 10:28:00
fcs
Hallo André,
Änderungen an Formelergebnissen lösen kein Change-Ereignis in Tabellen aus, dies geschieht nur bei Eingabe von Werten in Zellen.
Was man noch machen kann: Ein Makro auszuführen, wenn die Tabelle neu berechnet wird. Das kann aber evtl. sehr stark auf die Aktualisierungsgeschwindigkeit von Berechnungen in der Arbeitsmappe durchschlagen. Insbesondere, wenn komplexe Formeln verwendet werden.
nachfolgend ein Beispiel für deine Spaltenaktualiserung.
gruß
Franz

Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Spaltenbereich prüfen/ausfüllen
Call SpaltenPruefen(lngStartspalte:=4, lngEndspalte:=14)
Call SpaltenPruefen(lngStartspalte:=18, lngEndspalte:=28)
Call SpaltenPruefen(lngStartspalte:=32, lngEndspalte:=42)
Call SpaltenPruefen(lngStartspalte:=46, lngEndspalte:=56)
Call SpaltenPruefen(lngStartspalte:=60, lngEndspalte:=70)
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
Private Sub SpaltenPruefen(lngStartspalte As Long, lngEndspalte As Long)
'Prüft Zeile 6 der Spalten und passt Zellinhalte an
Dim wks As Worksheet, lngSpalte As Long
Set wks = ActiveSheet 'oder = Worksheets("TabelllenblattName")
With wks
'Spalten abarbeiten
For lngSpalte = lngStartspalte To lngEndspalte
'Eintrag in Zeile 6 der Spalten prüfen
Select Case .Cells(6, lngSpalte).Value
Case "frei", "krank", "Url"
.Range(.Cells(7, lngSpalte), .Cells(43, lngSpalte)).ClearContents
Case "früh"
.Range(.Cells(21, lngSpalte), .Cells(23, lngSpalte)).Value = "Mittag"
Case "spät"
.Range(.Cells(24, lngSpalte), .Cells(26, lngSpalte)).Value = "Mittag"
Case "kurz früh"
.Range(.Cells(31, lngSpalte), .Cells(43, lngSpalte)).ClearContents
Case "kurz spät"
.Range(.Cells(7, lngSpalte), .Cells(18, lngSpalte)).ClearContents
Case Else
'do nothing
End Select
Next
End With
End Sub


Anzeige
AW: Noch eine bzw. zwei Fragen...
24.09.2008 16:36:31
André
Hallo Franz,
ja ich bestätige: Das Makro geht sehr, sehr stark auf die Performance. Um nicht zu sagen, dass es nicht geht. Trotzdem sehr vielen Dank für deine schnellen und sehr hilfreichen Antworten.
Schade, dass es nicht klappt. Also war der erste Gedanke es mit einem Button zu machen der beste Gedanke.
So nächster Schritt ist die "Tägliche Auswertung":
Meine erste Idee war es, hier im Forum zu suchen, ob es da nicht schon was gibt. Leider erfolglos.
Dann habe ich versucht ein Makro aufzunehmen. Allerdings mit ernüchterndem Ergebnis.
Es sollte dann wie folgt funtionieren:
Wenn Klick Button "Auswertung Montag", dann kopiere die Inhalte aus Zellbereich C1:N54 in Arbeitsmappe "Auswertung" als neues Worksheet und gebe dann dem Worksheet als Namen das aktuelle Datum.
Hat aber dann doch nicht funtioniert.
Frage in die große Runde: Hat jemand eine Idee, wie man das lösen kann?
Danke und Gruß
André
Anzeige
Neues Thema! Neue Frage!
24.09.2008 16:39:00
André
Hallo Franz,
ja ich bestätige: Das Makro geht sehr, sehr stark auf die Performance. Um nicht zu sagen, dass es nicht geht. Trotzdem sehr vielen Dank für deine schnellen und sehr hilfreichen Antworten.
Schade, dass es nicht klappt. Also war der erste Gedanke es mit einem Button zu machen der beste Gedanke.
So nächster Schritt ist die "Tägliche Auswertung":
Meine erste Idee war es, hier im Forum zu suchen, ob es da nicht schon was gibt. Leider erfolglos.
Dann habe ich versucht ein Makro aufzunehmen. Allerdings mit ernüchterndem Ergebnis.
Es sollte dann wie folgt funtionieren:
Wenn Klick Button "Auswertung Montag", dann kopiere die Inhalte aus Zellbereich C1:N54 in Arbeitsmappe "Auswertung" als neues Worksheet und gebe dann dem Worksheet als Namen das aktuelle Datum.
Hat aber dann doch nicht funtioniert.
Frage in die große Runde: Hat jemand eine Idee, wie man das lösen kann?
Danke und Gruß
André
Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige