Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1204to1208
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

Makro nur teilweise ausgeführt

Makro nur teilweise ausgeführt
Chris
Hallo Excel-Forum,
unten stehendes Makro bewirkt, dass sich der Wert in Zelle B27 um 1 oder um 0,5 erhöht bzw. verringert - je nachdem welcher Begriff in verschiedenen Zellenbereichen eingeben wird. Läuft soweit ohne Probleme.
Nun möchte ich dasselbe Makro auf eine andere Zelle anwenden (B66) (und noch weitere 10 verschiedene Zellen mit unterschiedliche Bereichen). Ich habe daher das Makro kopiert, die Variablennamen geändert und die Bereiche angepasst.). Wenn ich das Makro starte, kommt zwar keine Fehlermeldung, aber der Wert in Zelle B66 ändert sich nicht. Es läuft immer nur das erste Makro für Zelle B27 - Excel ignoriert einfach den zweiten Teil.
Weiss jemand wieso?
Bei der Gelegenheit: Gib es evtl. eine einfachere Möglichkeit, als das Makro 10x zu kopieren und jeweils die Bereich anzupassen?
Schon mal danke,
Chris
HIer das Makro:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
Dim Zelle As Range
Dim BereichIntersect As Range
Dim Zelle1 As Range
Dim BereichIntersect1 As Range
Set BereichIntersect = Intersect(Target, Range("C28:C35,F28:F35,I28:I35,L28:L35,O28:O35"))
If BereichIntersect Is Nothing Then
Exit Sub
Else
For Each Zelle In BereichIntersect.Cells
Application.EnableEvents = False
Select Case Zelle.Value
Case Is = "Test1"
Worksheets(3).Cells(27, 2).Value = Worksheets(3).Cells(27, 2).Value -  _
Worksheets(5).Cells(Zelle.Row, Zelle.Column).Value
Worksheets(3).Cells(27, 2).Value = Worksheets(3).Cells(27, 2).Value + 0.5
Worksheets(5).Cells(Zelle.Row, Zelle.Column).Value = "0.5"
Case Is = "Test2"
Worksheets(3).Cells(27, 2).Value = Worksheets(3).Cells(27, 2).Value -  _
Worksheets(5).Cells(Zelle.Row, Zelle.Column).Value
Worksheets(3).Cells(27, 2).Value = Worksheets(3).Cells(27, 2).Value + 0.5
Worksheets(5).Cells(Zelle.Row, Zelle.Column).Value = 0.5
Case Is = "------"
Worksheets(3).Cells(27, 2).Value = Worksheets(3).Cells(27, 2).Value -  _
Worksheets(5).Cells(Zelle.Row, Zelle.Column).Value
'Wert aus Tabelle2 löschen
Worksheets(5).Cells(Zelle.Row, Zelle.Column).Value = ""
Case Else
Worksheets(3).Cells(27, 2).Value = Worksheets(3).Cells(27, 2).Value -  _
Worksheets(5).Cells(Zelle.Row, Zelle.Column).Value
Worksheets(3).Cells(27, 2).Value = Worksheets(3).Cells(27, 2).Value + 1
Worksheets(5).Cells(Zelle.Row, Zelle.Column).Value = "1"
End Select
Application.EnableEvents = True
Next
End If
Set BereichIntersect1 = Intersect(Target, Range("C67:C74,F67:F74,I67:I74,L67:L74,O67:O74"))
If BereichIntersect1 Is Nothing Then
Exit Sub
Else
For Each Zelle1 In BereichIntersect1.Cells
Application.EnableEvents = False
Select Case Zelle1.Value
Case Is = "Test1"
Worksheets(3).Cells(66, 2).Value = Worksheets(3).Cells(66, 2).Value -  _
Worksheets(5).Cells(Zelle1.Row, Zelle1.Column).Value
Worksheets(3).Cells(66, 2).Value = Worksheets(3).Cells(66, 2).Value + 0.5
Worksheets(5).Cells(Zelle1.Row, Zelle1.Column).Value = "0.5"
Case Is = "Test2"
Worksheets(3).Cells(66, 2).Value = Worksheets(3).Cells(66, 2).Value -  _
Worksheets(5).Cells(Zelle1.Row, Zelle1.Column).Value
Worksheets(3).Cells(66, 2).Value = Worksheets(3).Cells(66, 2).Value + 0.5
Worksheets(5).Cells(Zelle1.Row, Zelle1.Column).Value = 0.5
Case Is = "------"
Worksheets(3).Cells(66, 2).Value = Worksheets(3).Cells(66, 2).Value -  _
Worksheets(5).Cells(Zelle1.Row, Zelle1.Column).Value
Worksheets(5).Cells(Zelle1.Row, Zelle1.Column).Value = ""
Case Else
Worksheets(3).Cells(66, 2).Value = Worksheets(3).Cells(66, 2).Value -  _
Worksheets(5).Cells(Zelle1.Row, Zelle1.Column).Value
Worksheets(3).Cells(66, 2).Value = Worksheets(3).Cells(66, 2).Value + 1
Worksheets(5).Cells(Zelle1.Row, Zelle1.Column).Value = "1"
End Select
Application.EnableEvents = True
Next
End If
Exit Sub
Fehler: MsgBox Err.Description, vbInformation, "Fehler"
End Sub

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

Betreff
Benutzer
Anzeige
AW: Makro nur teilweise ausgeführt
09.03.2011 07:52:23
Reinhard
Moin Chris,
was soll das mit 0.5 und "0.5"?
in Modul des Blattes:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim BereichIntersect As Range, rngGross As Range
On Error GoTo Fehler
Application.EnableEvents = False
Set rngGross = Range("C28:C35,F28:F35,I28:I35,L28:L35,O28:O35")
Set rngGross = Application.Union(rngGross, Range("C67:C74,F67:F74,I67:I74,L67:L74,O67:O74"))
'Set rngGross = Application.Union(rngGross, Range("  noch ein Bereich  "))
Set BereichIntersect = Intersect(Target, rngGross)
If Not BereichIntersect Is Nothing Then Call Berechnung(BereichIntersect)
Fehler:
Application.EnableEvents = True
If Err.Number  0 Then MsgBox Err.Description, vbInformation, "Fehler"
End Sub

in allg. Modul, Modul1 o.ä.:

Option Explicit
Sub Berechnung(ByRef BereichIntersect As Range)
Dim Zelle As Range, rngZelle As Range
With Worksheets(3).Cells(27, 2)
For Each Zelle In BereichIntersect.Cells
Set rngZelle = Worksheets(5).Cells(Zelle.Row, Zelle.Column)
Select Case Zelle.Value
Case Is = "Test1"
.Value = .Value - rngZelle.Value
.Value = .Value + 0.5
rngZelle.Value = "0.5"
Case Is = "Test2"
.Value = .Value - rngZelle.Value
.Value = .Value + 0.5
rngZelle.Value = 0.5
Case Is = "------"
.Value = .Value - rngZelle.Value
rngZelle.Value = ""
Case Else
.Value = .Value - rngZelle.Value
.Value = .Value + 1
rngZelle.Value = "1"
End Select
Next Zelle
End With
End Sub

Gruß
Reinhard
Anzeige
AW: Makro nur teilweise ausgeführt
09.03.2011 17:06:31
Chris
Hallo Reinhard,
danke für das Makro. ISt ist nicht ganz das was ich brauche. Im Moment ist es ja so, dass bei Eingabe von "Test1" und "Test2" in den Bereichen
Set rngGross = Range("C28:C35,F28:F35,I28:I35,L28:L35,O28:O35")
Set rngGross = Application.Union(rngGross, Range("C67:C74,F67:F74,I67:I74,L67:L74,O67:O74"))
der Wert sich von Zelle B27 erhöht, doch auch diese Zelle soll ich ändern:
Bei Eingabe von "Test1" "Test2" im Range (C28:O35 (der lange oben, ich kürze ab...)) soll sich Zelle B27 ändern.
Bei Eingabe von "Test1" "Test2" im Range (C67:O74 auch hier wieder abgekürzt) soll sich Zelle B66(!!!) ändern.
Also: Anderer Range andere Zelle! (und davon jeweils 10 verschiedene).
Danke schon mal,
Chris
Anzeige
Sorry, dann kapier ich das nicht ow.wT.
09.03.2011 17:26:33
Reinhard


AW: Sorry, dann kapier ich das nicht ow.wT.
09.03.2011 17:48:11
Chris
Hallo Reihart,
ich probiers nochmal: Das Makro soll die Arbeitsstunden von Mitarbeitern berechnen, sobald man bestimmte Wörter in bestimmten Zellenbereichen eingibt. Die Namen der Mitarbeiter und die Arbeitsstunden werden mir in einem excel-sheet untereinander angezeigt. Für jeden MItarbeiter gilt ein anderer Bereich. 10 Mitarbeiter, 10 verschiedene Bereiche und 10 verschiedene Zellen in Spalte B, deren Wert sich ändern:
Für Mitarbeiter 1 gilt der Bereich:
C28:C35,F28:F35,I28:I35,L28:L35,O28:O35
Gibt man hier "Test1" oder "Test2" ein, erhöht sich der Wert von Zelle B27 beispw. um 0.5
Für Mitarbeiter 2 gilt der Bereich:
C67:C74,F67:F74,I67:I74,L67:L74,O67:O74
Gibt man hier "Test1" oder "Test2" ein, erhöht sich der Wert von Zelle B66 (!!!!) beispw. um 0.5
usw. Bereich kann ich selber festlegen. Aber mein Makro mit veränderten RangeVariablen wird nicht wirklich ausgeführt. Es ändern sich immer nur der Wert in Zelle B27.....
Ich hoffe, diese Erklärung hilft.
Chris
Anzeige
Frage noch offen owT
09.03.2011 20:03:36
Reinhard


jetzt wirklich noch offen owT
09.03.2011 22:14:44
MichaV
owt
AW: jetzt wirklich noch offen owT
10.03.2011 00:43:58
Reinhard
Hallo Micha,
schön dich wieder mal zu lesen.
Könnte denn Hans nix einbauen, daß wenn im Betreff steht "Frage noch offen"m daß dann automatisch die Frage noch auf offen gestellt wird.
Das wäre mir sehr hilfreich, hier grad nicht das was ich gleich beschreibe,
da ist eine Anfrage, ich mache mir Gedanken dazu, eventuell auch Teillösungen o,ä,, schreib die hier rein und sage vielleicht noch dazu im Text Fage noch offen, aber vergesse das doofe Häkchen zu machen :-(.
Wie grad heute, da hatte ich das auf die Art vergessen. Das fiel mir auf., Dann ahbe ich halt nochmal gebeitragt mit jetzt ist die Frage noch offen.
Und *schäm*, dabei schon wieder vergessen das Häkchen zu setzen :-(
Also, DRITTER Versuch, nochmal das Gleiche, diesmal klappte alles, naja, bis Hajo auftauchte :-(
Wie auch immer, für MICH wäre das Klasse, wenn ich durch eine Textfolge im Betreff oder Beitragstext dieses Häkchen setzen könnte.
Ja, bin ein Träumer :-)
Gruß
Reinhard
Anzeige
AW: jetzt wirklich noch offen MT!
10.03.2011 07:56:20
MichaV
...vlt. wäre auch ein Automatismus sinnvoll, der die Eingabe von oT im Betreff verhindert, wenn im Beitrag viel Text steht ;o)
Gruss, diesmal aus Dänemark- Micha
PS: ich schau hier öfter rein um zu sehen was ihr so treibt.
vielleicht liegt es am Exit Sub
10.03.2011 09:52:20
Tino
Hallo,
ohne Deinen Code zu testen würde ich als erstes auf das Exit Sub tippen.
Wenn BereichIntersect Nothing ist wird der Code mit Exit Sub abgebrochen.
Vielleicht die Frage umkehren und nur mit If ohne Else- Part arbeiten.
If Not BereichIntersect Is Nothing Then
For Each Zelle In BereichIntersect.Cells
End If
Gruß Tino
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige