Herbers Excel-Forum - das Archiv

Makro

Bild

Betrifft: Makro
von: Tom

Geschrieben am: 31.12.2006 13:46:03
Hallo.
Habe bisher folgendes Makro das auch soweit funktioniert. Möchte es nun etwas "verbessern".
wenn sich nun in den zellen d12 bis d16 (sonntag) etwas ändert sollte auch nur der betreffende teil des makros bearbeitet werden und nicht das ganze makro durchlaufen werden. das ganze dann eben auch für montag, dienstag,...
desweiteren möchte ich gern wenn eine zeile ausgeblendet wird, das dann die werte in der ausgeblendeten zeile von der spalte a, b, e, f, gelöscht werden.
kann mir da vielleicht jemand weiter helfen?
viele grüße tom
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("b12:b79")
If Intersect(Target, rng) Is Nothing Then Exit Sub
'' sonntag
Rows(13).Hidden = IsEmpty(Range("d12"))
Rows(14).Hidden = IsEmpty(Range("d13"))
Rows(15).Hidden = IsEmpty(Range("d14"))
Rows(16).Hidden = IsEmpty(Range("d15"))
Rows(17).Hidden = IsEmpty(Range("d16"))
'' montag
Rows(19).Hidden = IsEmpty(Range("d18"))
Rows(20).Hidden = IsEmpty(Range("d19"))
Rows(21).Hidden = IsEmpty(Range("d20"))
Rows(22).Hidden = IsEmpty(Range("d21"))
Rows(23).Hidden = IsEmpty(Range("d22"))
Rows(24).Hidden = IsEmpty(Range("d23"))
Rows(25).Hidden = IsEmpty(Range("d24"))
Rows(26).Hidden = IsEmpty(Range("d25"))
'' dienstag
Rows(28).Hidden = IsEmpty(Range("d27"))
Rows(29).Hidden = IsEmpty(Range("d28"))
Rows(30).Hidden = IsEmpty(Range("d29"))
Rows(31).Hidden = IsEmpty(Range("d30"))
Rows(32).Hidden = IsEmpty(Range("d31"))
Rows(33).Hidden = IsEmpty(Range("d32"))
Rows(34).Hidden = IsEmpty(Range("d33"))
Rows(35).Hidden = IsEmpty(Range("d34"))
'' mittwoch
Rows(37).Hidden = IsEmpty(Range("d36"))
Rows(38).Hidden = IsEmpty(Range("d37"))
Rows(39).Hidden = IsEmpty(Range("d38"))
Rows(40).Hidden = IsEmpty(Range("39"))
Rows(41).Hidden = IsEmpty(Range("d40"))
Rows(42).Hidden = IsEmpty(Range("d41"))
Rows(43).Hidden = IsEmpty(Range("d42"))
Rows(44).Hidden = IsEmpty(Range("d43"))
'' donnerstag
Rows(46).Hidden = IsEmpty(Range("d45"))
Rows(47).Hidden = IsEmpty(Range("d46"))
Rows(48).Hidden = IsEmpty(Range("d47"))
Rows(49).Hidden = IsEmpty(Range("d48"))
Rows(50).Hidden = IsEmpty(Range("d49"))
Rows(51).Hidden = IsEmpty(Range("d50"))
Rows(52).Hidden = IsEmpty(Range("d51"))
Rows(53).Hidden = IsEmpty(Range("d52"))
'' freitag
Rows(55).Hidden = IsEmpty(Range("d54"))
Rows(56).Hidden = IsEmpty(Range("d55"))
Rows(57).Hidden = IsEmpty(Range("d56"))
Rows(58).Hidden = IsEmpty(Range("d57"))
Rows(59).Hidden = IsEmpty(Range("d58"))
Rows(60).Hidden = IsEmpty(Range("d59"))
Rows(61).Hidden = IsEmpty(Range("d60"))
Rows(62).Hidden = IsEmpty(Range("d61"))
'' samstag
Rows(64).Hidden = IsEmpty(Range("d63"))
Rows(65).Hidden = IsEmpty(Range("d64"))
Rows(66).Hidden = IsEmpty(Range("d65"))
Rows(67).Hidden = IsEmpty(Range("d66"))
Rows(68).Hidden = IsEmpty(Range("d67"))
Rows(69).Hidden = IsEmpty(Range("d68"))
Rows(70).Hidden = IsEmpty(Range("d69"))
Rows(71).Hidden = IsEmpty(Range("d70"))
'' sonntag
Rows(73).Hidden = IsEmpty(Range("d72"))
Rows(74).Hidden = IsEmpty(Range("d73"))
Rows(75).Hidden = IsEmpty(Range("d74"))
Rows(76).Hidden = IsEmpty(Range("d75"))
Rows(77).Hidden = IsEmpty(Range("d76"))
Rows(78).Hidden = IsEmpty(Range("d77"))
Rows(79).Hidden = IsEmpty(Range("d78"))
Rows(80).Hidden = IsEmpty(Range("d79"))
End Sub

Bild

Betrifft: AW: Makro
von: HAW

Geschrieben am: 31.12.2006 17:38:31
Hallo Tom,
hier eine (ungetestete) Möglichkeit:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng(1 To 8) As Range, Bereich As Range
Dim grng As Range, z As Range, i%
Set grng = Range("B12:B79")
If Intersect(Target, grng) Is Nothing Then Exit Sub
Application.EnableEvents = False
Set rng(1) = Range("B13:B17")
Set rng(2) = Range("B19:B26")
Set rng(3) = Range("B28:B35")
Set rng(4) = Range("B37:B44")
Set rng(5) = Range("B46:B53")
Set rng(6) = Range("B55:B62")
Set rng(7) = Range("B64:B71")
Set rng(8) = Range("B73:B80")
For i = 1 To 8
Set Bereich = rng(i)
If Not Intersect(Target, Bereich) Is Nothing Then
For Each z In rng(i)
z.EntireRow.Hidden = IsEmpty(z.Offset(0, 2))
z.Offset(0, -1).ClearContents
z.ClearContents
z.Offset(0, 3).ClearContents
z.Offset(0, 4).ClearContents
Next z
Application.EnableEvents = True
Exit For
End If
Next i
End Sub

Gruß Heinz
Bild

Betrifft: AW: Makro
von: Tom

Geschrieben am: 31.12.2006 20:00:30
Hallo Heinz
funktioniert leider nicht. die zeilen werden weder ein- noch ausgeblendet. mein wissen reicht leider nicht aus um zu beurteilen wo der fehler liegt.
bei meinem code den ich anfangs hier getippselt hatte viel mir leider ein fehler auf. nachfolgend der richtige teil.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("d12:d79")
If Intersect(Target, rng) Is Nothing Then Exit Sub
...
viele grüße und gutes neues jahr
tom
Bild

Betrifft: AW: Makro
von: HAW

Geschrieben am: 31.12.2006 20:16:04
Hallo Tom,
das konnte dann ja auch nicht funktionieren, da ers sich ja umeien anderen Bereich dreht, also hier nochmal:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng(1 To 8) As Range, Bereich As Range
Dim grng As Range, z As Range, i%
Set grng = Range("D12:D79")
If Intersect(Target, grng) Is Nothing Then Exit Sub
Application.EnableEvents = False
Set rng(1) = Range("D13:D17")
Set rng(2) = Range("D19:D26")
Set rng(3) = Range("D28:D35")
Set rng(4) = Range("D37:D44")
Set rng(5) = Range("D46:D53")
Set rng(6) = Range("D55:D62")
Set rng(7) = Range("D64:D71")
Set rng(8) = Range("D73:D80")
For i = 1 To 8
Set Bereich = rng(i)
If Not Intersect(Target, Bereich) Is Nothing Then
For Each z In rng(i)
z.EntireRow.Hidden = IsEmpty(z)
z.Offset(0, -3).ClearContents
z.Offset(0, -2).ClearContents
z.Offset(0, 1).ClearContents
z.Offset(0, 2).ClearContents
Next z
Application.EnableEvents = True
Exit For
End If
Next i
End Sub

Gruß Heinz
Bild

Betrifft: AW: Makro
von: Tom

Geschrieben am: 31.12.2006 21:18:22
Hallo Heinz
hatte das schon berücksichtigt in deiner formel brachte aber nichts. blendet keine zeilen ein bzw aus.
ziel ist es einfach wenn in einer zeile von der spalte d ein text oder zahl eingefügt wird, das dann die nachfolgende zeile eingeblendet wird. ist die entsprechende zelle leer soll die nachfolgende zeile ausgeblendet und in den entsprechenden bereichen die werte gelöscht werden.
gruß tom
bis nächstes jahr ;-)
Bild

Betrifft: AW: Makro
von: HAW
Geschrieben am: 31.12.2006 22:22:05
Hallo Tom,
dann kann es nur sein, dass du den Code in ein normales Modul und nicht in das Klassenmodul der Tabelle kopiert hast, denn nur dann reagiert der Code auf das Ereignis des Eintragens.
Gruß Heinz
Bild

Betrifft: AW: Makro
von: Tom

Geschrieben am: 01.01.2007 17:13:56
Hallo an Alle und ein gutes neues Jahr 2007
@ heinz
hatte das makro nicht im modul sondern im zugehörigen tabellenmodul, sprich da wo vorher mein ehemaliges makro drin war. geht aber leider nichts. auch wenn ich ein neues blatt anlege in dem nur das makro ohne sonstigen funktionen und makros ist, funktioniert es leider nicht.
vielleicht weiß ja jemand etwas damit anzufangen
viele grüße tom
Bild

Betrifft: AW: Makro
von: Tom

Geschrieben am: 01.01.2007 19:05:24
@ heinz
nachtrag
habe noch einmal rumgetestet und folgendes festgestellt.
wenn ich zum beispiel d13 einen wert rauslösche wird selbige zeile ausgeblendet.
wenn ich jedoch in zelle d 13 ein wert ist soll zeile 14 eingeblendet werden und wenn d13 leer ist soll zeile 14 ausgeblendet werden.
nachfolgend mein noch aktuelles makro
gruß tom
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("d12:d79")
If Intersect(Target, rng) Is Nothing Then Exit Sub
'' sonntag
Rows(13).Hidden = IsEmpty(Range("d12"))
Rows(14).Hidden = IsEmpty(Range("d13"))
Rows(15).Hidden = IsEmpty(Range("d14"))
Rows(16).Hidden = IsEmpty(Range("d15"))
Rows(17).Hidden = IsEmpty(Range("d16"))
'' montag
Rows(19).Hidden = IsEmpty(Range("d18"))
Rows(20).Hidden = IsEmpty(Range("d19"))
Rows(21).Hidden = IsEmpty(Range("d20"))
Rows(22).Hidden = IsEmpty(Range("d21"))
Rows(23).Hidden = IsEmpty(Range("d22"))
Rows(24).Hidden = IsEmpty(Range("d23"))
Rows(25).Hidden = IsEmpty(Range("d24"))
Rows(26).Hidden = IsEmpty(Range("d25"))
'' dienstag
Rows(28).Hidden = IsEmpty(Range("d27"))
Rows(29).Hidden = IsEmpty(Range("d28"))
Rows(30).Hidden = IsEmpty(Range("d29"))
Rows(31).Hidden = IsEmpty(Range("d30"))
Rows(32).Hidden = IsEmpty(Range("d31"))
Rows(33).Hidden = IsEmpty(Range("d32"))
Rows(34).Hidden = IsEmpty(Range("d33"))
Rows(35).Hidden = IsEmpty(Range("d34"))
'' mittwoch
Rows(37).Hidden = IsEmpty(Range("d36"))
Rows(38).Hidden = IsEmpty(Range("d37"))
Rows(39).Hidden = IsEmpty(Range("d38"))
Rows(40).Hidden = IsEmpty(Range("d39"))
Rows(41).Hidden = IsEmpty(Range("d40"))
Rows(42).Hidden = IsEmpty(Range("d41"))
Rows(43).Hidden = IsEmpty(Range("d42"))
Rows(44).Hidden = IsEmpty(Range("d43"))
'' donnerstag
Rows(46).Hidden = IsEmpty(Range("d45"))
Rows(47).Hidden = IsEmpty(Range("d46"))
Rows(48).Hidden = IsEmpty(Range("d47"))
Rows(49).Hidden = IsEmpty(Range("d48"))
Rows(50).Hidden = IsEmpty(Range("d49"))
Rows(51).Hidden = IsEmpty(Range("d50"))
Rows(52).Hidden = IsEmpty(Range("d51"))
Rows(53).Hidden = IsEmpty(Range("d52"))
'' freitag
Rows(55).Hidden = IsEmpty(Range("d54"))
Rows(56).Hidden = IsEmpty(Range("d55"))
Rows(57).Hidden = IsEmpty(Range("d56"))
Rows(58).Hidden = IsEmpty(Range("d57"))
Rows(59).Hidden = IsEmpty(Range("d58"))
Rows(60).Hidden = IsEmpty(Range("d59"))
Rows(61).Hidden = IsEmpty(Range("d60"))
Rows(62).Hidden = IsEmpty(Range("d61"))
'' samstag
Rows(64).Hidden = IsEmpty(Range("d63"))
Rows(65).Hidden = IsEmpty(Range("d64"))
Rows(66).Hidden = IsEmpty(Range("d65"))
Rows(67).Hidden = IsEmpty(Range("d66"))
Rows(68).Hidden = IsEmpty(Range("d67"))
Rows(69).Hidden = IsEmpty(Range("d68"))
Rows(70).Hidden = IsEmpty(Range("d69"))
Rows(71).Hidden = IsEmpty(Range("d70"))
'' sonntag
Rows(73).Hidden = IsEmpty(Range("d72"))
Rows(74).Hidden = IsEmpty(Range("d73"))
Rows(75).Hidden = IsEmpty(Range("d74"))
Rows(76).Hidden = IsEmpty(Range("d75"))
Rows(77).Hidden = IsEmpty(Range("d76"))
Rows(78).Hidden = IsEmpty(Range("d77"))
Rows(79).Hidden = IsEmpty(Range("d78"))
Rows(80).Hidden = IsEmpty(Range("d79"))
End Sub

Bild

Betrifft: AW: Makro
von: HAW

Geschrieben am: 01.01.2007 20:30:50
Hallo Tom,
ja, das habe ich übersehen, dass immer die näc hste Zeile ausgeblendet werden soll.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng(1 To 8) As Range, Bereich As Range
Dim grng As Range, z As Range, i%
Set grng = Range("D12:D79")
If Intersect(Target, grng) Is Nothing Then Exit Sub
Application.EnableEvents = False
Set rng(1) = Range("D13:D17")
Set rng(2) = Range("D19:D26")
Set rng(3) = Range("D28:D35")
Set rng(4) = Range("D37:D44")
Set rng(5) = Range("D46:D53")
Set rng(6) = Range("D55:D62")
Set rng(7) = Range("D64:D71")
Set rng(8) = Range("D73:D80")
For i = 1 To 8
Set Bereich = rng(i)
If Not Intersect(Target, Bereich) Is Nothing Then
For Each z In rng(i)
z.EntireRow.Hidden = IsEmpty(z.Offset(-1, 0))
z.Offset(0, -3).ClearContents
z.Offset(0, -2).ClearContents
z.Offset(0, 1).ClearContents
z.Offset(0, 2).ClearContents
Next z
Application.EnableEvents = True
Exit For
End If
Next i
End Sub

Gruß Heinz
Bild

Betrifft: AW: Makro
von: Tom
Geschrieben am: 02.01.2007 20:42:02
Hallo Heinz
hab es gerade ausprobiert. Tut sich aber sonderbar wenig. Also leider gar nichts.
Gruß tom
Bild

Betrifft: AW: Makro
von: HAW
Geschrieben am: 03.01.2007 20:05:48
Hallo Tom,
das kann ich nicht verstehen. Du hast doch gesagt, dass dieselbe Zeile ausgeblendet wird, nun soll sich nichts tun, das ist mir unerklärlich.
Am besten du eröffnest einen neuen Thread, vielleicht hat jemand anderer eine Idee.
Gruß Heinz
Bild

Betrifft: AW: Makro
von: Tom

Geschrieben am: 03.01.2007 20:41:19
Hallo Heinz
vielen Dank für deine Mühen.
Das mit dem ausblenden hab ich noch einmal getestet. es werden nur zeilen ausgeblendet von dem rng bei dem ich direkt nach der eingabe des vba-code und dessen abspeichern etwas änder. anschließend geht nichts mehr. egal ob ich nocheinmal speicher oder excel schließe und neustarte.
werde nun ein neuen threat aufmachen. danke dir.
gruß tom
Bild

Betrifft: AW: Makro
von: haw

Geschrieben am: 04.01.2007 07:03:53
Hallo Tom,
da hast du vermutlich etwas missverstanden.
Das Makro ist ein sogenanntes Ereignismakro und wird durch das Ereignis der Änderung einer Zelle im festgelegten Bereich ausgelöst. Wenn dieses Ereignis nicht stattfindet, wird das Makro auch nicht gestartet. Wenn du beim Speichern oder Öffnen einer Datei ein Makro gestartet haben willst, dann müssen eben weitere Ereignismakros, die auf diese Ereignisse reagieren geschrieben werden.
Gruß Heinz
Bild

Betrifft: AW: Makro
von: tom

Geschrieben am: 04.01.2007 18:09:32
Hallo Heinz
habe mich vielleicht etwas unglücklich ausgedrückt. also trotz abspeichern und neustarten funktioniert das makro nicht wenn ich im entsprechenden bereich die werte änder bzw lösche
gruß tom
 Bild