Help! VBA geht nicht
17.02.2006 15:14:23
mario
Ich habe in einer Tabelle(Urlaubsplaner) in der sich schon einen Vbacode befindet(für die Zeit), und die zellen sind mit formeln belegt, einen neuen Vbacode eingefügt(zum Farben formatieren der zellen, da die bedingte formatierung schon alle drei felder belegt sind).
Der geht jetzt aber nur wenn ich die Formeln aus den zellen lösche.? warum?
Ich bekomme keine fehlermeldung wenn ich den Code einfüge, habe ich überprüft mit Kompilieren vom VBAProjekt.
Was mache ich da falsch? muss ich vieleicht zwischen dem alten und neuen vbacode noch was einfügen? oder fehlt was in dem neuen Code das die formel noch extra berücksichtigt werden müssen?.
Ich habe gerade begonnen VBA zulernen, und bin über jeden Tipp dankbar den Ihr mir geben könnt.Ich schicke die Tabelle gerne per E-Mail zu, sie ist leider zu groß um hier ins Forum zustellen, dann mit der genauen erklärung der Probleme, wenn mir jemand helfen kann.
Das ist der VBAcode der im Urlaubsplaner ist:
' entweder DoppelClick
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
' oder EinfachClick
'
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim x As Byte, y As Byte
Dim Beginn As Date, Ende As Date
Dim txt As String, Grund As String
Dim Zeile As Long, dat As Long, Anzahl As Long, gAnzahl As Long
Select Case Target.Address
Case "$A$8", "$A$23", "$A$36"
Zeile = 8
Case "$A$9", "$A$24", "$A$37"
Zeile = 9
Case "$A$10", "$A$25", "$A$38"
Zeile = 10
Case "$A$11", "$A$26", "$A$39"
Zeile = 11
Case "$A$12", "$A$27", "$A$40"
Zeile = 12
Case "$A$13", "$A$28", "$A$41"
Zeile = 13
Case "$A$14", "$A$29", "$A$42"
Zeile = 14
Case Else
GoTo zumEnde
End Select
dat = 5 ' Datumszeile
Beginn = 0 ' Startwert Null
Ende = 0 ' Startwert Null
Anzahl = 0 ' Startwert Null
Grund = "" ' Startwert Null
txt = "" ' Startwert Null
UserForm1.ListBox1.Clear
' Tage ermitteln
For y = 1 To 2 ' Halbjahr Schleife Januar-Juni und Juli-Dezember
For x = 2 To 185 ' Datumsbereich Schleife
If Cells(Zeile, x) = Sheets("Urlaub").[K2] And Cells(Zeile, x - 1) <> Sheets("Urlaub").[K2] Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K3] And Cells(Zeile, x - 1) <> Sheets("Urlaub").[K3] Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K4] And Cells(Zeile, x - 1) <> Sheets("Urlaub").[K4] Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K5] And Cells(Zeile, x - 1) <> Sheets("Urlaub").[K5] Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K6] And Cells(Zeile, x - 1) <> Sheets("Urlaub").[K6] Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K7] And Cells(Zeile, x - 1) <> Sheets("Urlaub").[K7] Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K8] And Cells(Zeile, x - 1) <> Sheets("Urlaub").[K8] Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K9] And Cells(Zeile, x - 1) <> Sheets("Urlaub").[K9] Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K10] And Cells(Zeile, x - 1) <> Sheets("Urlaub").[K10] Then Beginn = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K11] And Cells(Zeile, x - 1) <> Sheets("Urlaub").[K11] Then Beginn = Cells(dat, x)
' Zeitraumende ermitteln
If Cells(Zeile, x) = Sheets("Urlaub").[K2] And Cells(Zeile, x + 1) <> Sheets("Urlaub").[K2] Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K3] And Cells(Zeile, x + 1) <> Sheets("Urlaub").[K3] Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K4] And Cells(Zeile, x + 1) <> Sheets("Urlaub").[K4] Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K5] And Cells(Zeile, x + 1) <> Sheets("Urlaub").[K5] Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K6] And Cells(Zeile, x + 1) <> Sheets("Urlaub").[K6] Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K7] And Cells(Zeile, x + 1) <> Sheets("Urlaub").[K7] Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K8] And Cells(Zeile, x + 1) <> Sheets("Urlaub").[K8] Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K9] And Cells(Zeile, x + 1) <> Sheets("Urlaub").[K9] Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K10] And Cells(Zeile, x + 1) <> Sheets("Urlaub").[K10] Then Ende = Cells(dat, x)
If Cells(Zeile, x) = Sheets("Urlaub").[K11] And Cells(Zeile, x + 1) <> Sheets("Urlaub").[K11] Then Ende = Cells(dat, x)
' wenn Anfang und Ende ermittelt Text fortschreiben
If Beginn <> 0 And Ende <> 0 Then
If Cells(Zeile, x) = Sheets("Urlaub").[K2] Then Grund = Sheets("Urlaub").[L2]
If Cells(Zeile, x) = Sheets("Urlaub").[K3] Then Grund = Sheets("Urlaub").[L3]
If Cells(Zeile, x) = Sheets("Urlaub").[K4] Then Grund = Sheets("Urlaub").[L4]
If Cells(Zeile, x) = Sheets("Urlaub").[K5] Then Grund = Sheets("Urlaub").[L5]
If Cells(Zeile, x) = Sheets("Urlaub").[K6] Then Grund = Sheets("Urlaub").[L6]
If Cells(Zeile, x) = Sheets("Urlaub").[K7] Then Grund = Sheets("Urlaub").[L7]
If Cells(Zeile, x) = Sheets("Urlaub").[K8] Then Grund = Sheets("Urlaub").[L8]
If Cells(Zeile, x) = Sheets("Urlaub").[K9] Then Grund = Sheets("Urlaub").[L9]
If Cells(Zeile, x) = Sheets("Urlaub").[K10] Then Grund = Sheets("Urlaub").[L10]
If Cells(Zeile, x) = Sheets("Urlaub").[K11] Then Grund = Sheets("Urlaub").[L11]
Anzahl = DateDiff("d", Beginn, Ende) + 1
' mitzählen in der Auflistung ja/nein
If Grund = Sheets("Urlaub").[L2] And Sheets("Urlaub").[M2] = "Nein" Then GoTo weiter
If Grund = Sheets("Urlaub").[L3] And Sheets("Urlaub").[M3] = "Nein" Then GoTo weiter
If Grund = Sheets("Urlaub").[L4] And Sheets("Urlaub").[M4] = "Nein" Then GoTo weiter
If Grund = Sheets("Urlaub").[L5] And Sheets("Urlaub").[M5] = "Nein" Then GoTo weiter
If Grund = Sheets("Urlaub").[L6] And Sheets("Urlaub").[M6] = "Nein" Then GoTo weiter
If Grund = Sheets("Urlaub").[L7] And Sheets("Urlaub").[M7] = "Nein" Then GoTo weiter
If Grund = Sheets("Urlaub").[L8] And Sheets("Urlaub").[M8] = "Nein" Then GoTo weiter
If Grund = Sheets("Urlaub").[L9] And Sheets("Urlaub").[M9] = "Nein" Then GoTo weiter
If Grund = Sheets("Urlaub").[L10] And Sheets("Urlaub").[M10] = "Nein" Then GoTo weiter
If Grund = Sheets("Urlaub").[L11] And Sheets("Urlaub").[M11] = "Nein" Then GoTo weiter
gAnzahl = gAnzahl + Anzahl
weiter:
' nur 1 Tag, dann Startdatum
If Anzahl = 1 Then txt = " " & Beginn & " = " & Anzahl & " " & Grund
' mehr als 1 Tag, dann Start und Enddatum
If Anzahl > 1 Then txt = " " & Beginn & " bis " & Ende & " = " & Anzahl & " " & Grund
Beginn = 0 ' zurückstellen
Ende = 0 ' zurückstellen
Anzahl = 0 ' zurückstellen
Grund = "" ' zurückstellen
' in ListBox eintragen
UserForm1.ListBox1.AddItem txt
UserForm1.ListBox1.ListIndex = 0
End If
' nächsten Tag finden (Datumsbereich Schleife)
Next x
' nächstes Halbjahr durchsuchen (Halbjahr Schleife)
Zeile = Zeile + 15
dat = dat + 15
Next y
' Userform anzeigen mit Mitarbeiternamen in Fensterüberschrift
UserForm1.Caption = Cells(Target.Row, 1) & " hat " & gAnzahl & " Tage genommen/verplant."
UserForm1.Show
zumEnde:
[a1].Select
End Sub
Jetzt der denn ich einfügen möchte dann ohne option explicit:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' HINTERGRUND
' für Schrift RaZelle.Font.ColorIndex
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("B8:FZ21, B28:FZ41, B48:FZ59, B66:FZ74")
' noch mehr Bereiche
' Set RaBereich = Union(Range("C7:I26"), Range("L7:R26"), Range("U7:AA26"), Range("AD7:AJ26"))
' ab Vesion XP braucht der Schutz nicht aufgehoben werden
' Formatierung bei Schutz kann über Dialog Schutz eingestellt werden
' ActiveSheet.Unprotect ("Passwort")
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
With RaZelle
Select Case UCase(.Value) ' UMWANDLUNG DER Eingabe in Großbuchstaben
Case "U"
.Interior.ColorIndex = 1
' schwarz
.Font.ColorIndex = 2
' Schriftfarbe weiß
'.NumberFormat = "General"
' Zellenformat Standard
Case "FR"
.Interior.ColorIndex = 6
' weiß
.Font.ColorIndex = 0
' Schriftfarbe automatisch
'.NumberFormat = "General"
' Zellenformat Standard
Case "K"
.Interior.ColorIndex = 3
' rot
.Font.ColorIndex = 2
' Schriftfarbe Weiß
'.NumberFormat = ";;;"
' nicht sichtbar
Case "BT"
.Interior.ColorIndex = 4
' grün
.Font.ColorIndex = 0
' Schriftfarbe automatisch
'.NumberFormat = "General"
' Zellenformat Standard
Case "WS"
.Interior.ColorIndex = 5
' blau
.Font.ColorIndex = 15
' Schriftfarbe automatisch
'.NumberFormat = "General"
' Zellenformat Standard
Case Else
.Interior.ColorIndex = xlNone
' Keine
.Font.ColorIndex = 0
' Schriftfarbe automatisch
'.NumberFormat = "General"
' Zellenformat Standard
End Select
End With
End If
Next RaZelle
' ActiveSheet.protect ("Passwort")
Set RaBereich = Nothing
End Sub
Kennt sich damit jemand aus? wäre klasse wenn mir jemand helfen könnte mache damit schon wochen mit rum.
Gruß Mario