Clever-Excel-Forum

Hallo Leute,
Ich habe folgendes Problem:
Ich habe eine Excel Datei mit mehreren Tabellenblättern. In diesen Tabellenblättern soll das Datum in Spalte „H“ ab Zeile 10 aktualisiert werden, der Code durch läuft alle Tabellenblätter, die in der Datei sind.
Alter Code   ( Teilausschnitt )

For Each Zelle In WkSh_ZB.Sheets(tabReg).Range("H10:H50")

Dieser Code funktioniert einwandfrei!

Nun haben sich aus verschieden Gründen die Tabellenblätter geändert, so dass nicht mehr nur der Bereich H10:H50, sondern auch andere Bereiche nacheinander in „H60: bisH? “  usw. nach unten aktualisiert werden müssen.  Die Bereiche werden auch jeweils mit dem Code ermittelt.
Dafür habe ich versucht diesen Code mit Variablen zu verwenden

Neuer Code (Teilausschnitt)
For Each Zelle In WkSh_ZB.Sheets(tabReg).Range(Cells(gefunden, Spalte), Cells(letzteBzeile1, Spalte))

Benutze ich diesen Code bekomme ich den:

Laufzeitfehler 1004
Anwendungs- oder objektdefiniter Fehler

Als Hinwies noch:
Wenn ich in das Tabellenplatt klicke und mit F8 weiter mache läuft der Code durch.
  Was im alten Code NICHT SO WAR!

Im Anschluss noch der komplette Code


 Sub Testsuchen2(ByVal tabReg As String)
Dim rng As Range
Dim meinbereich As Range
Dim letzteBzeile As Long
Dim jona As Long
Dim Wortgefunden As Long, gefunden As Long
Dim letzteBzeile1 As Long
Dim zeileff As Range, spalteff As Range
Dim Ende As Long
Dim AktuellesDatum As Date, datFrist As Date, datsecond As Date
Dim strWieviel As String
Dim vntFarben As Variant                                    'Farben
Dim Zelle As Range, c As Range, fz As Range
Dim Zelleeinf As Range
Dim wksTab As Worksheet
Dim liZeile As Integer
Dim lz As Long, lngC As Long, a As Long
Dim Spalte As Integer
'1. Schritt: Finde die letzte beschriebene Zeile
    'Finde die letzte beschriebene Zeile im Tabellenblatt im ActivenSheet

'With WkSh_ZB.Sheets(tabReg)

Ende = WkSh_ZB.Sheets(tabReg).Cells.SpecialCells(xlCellTypeLastCell).Row
'MsgBox Ende
letzteBzeile = WkSh_ZB.Sheets(tabReg).Cells(Rows.count, 5).End(xlUp).Row
'MsgBox letzteBzeile
'2. Schritt:
For i = 1 To letzteBzeile
'Suche nach dem Wort im Registerblatt in Spalte A
Set rng = WkSh_ZB.Sheets(tabReg).Cells(i, 1).Find(What:="Wartungsplan", LookIn:=xlValues, lookat:=xlWhole) ', _
'SearchOrder:=xlByRows, SearchDirection:=xlNext)
'Wenn gefunden gib Meldung
If rng Is Nothing Then
'MsgBox "Nichts gefunden"
'Exit Sub
Else
MsgBox "Zeile: " & rng.Row & ";  Adresse: " & rng.Address
Wortgefunden = rng.Row
gefunden = rng.Row + 9
'jona = rng.Row + 9
   
  'WkSh_ZB.Sheets(tabReg).Cells(jona, 5).Select
    'ActiveSheet.Cells(jona, 5).Select
        letzteBzeile1 = WkSh_ZB.Sheets(tabReg).Cells(gefunden, 5).End(xlDown).Row
          'WkSh_ZB.Sheets(tabReg).Cells(letzteBzeile1, 5).Select
                'gefunden = letzteBzeile1 + 1

'Set meinbereich = .Range(Cells(gefunden, 8), Cells(letzteBzeile1, 8))
Spalte = 8
'Hier wird das Datum Aktuallisiert, die Zellen und das Tabellenblatt eingefärbt
'1.Datum Aktualliesieren
'2.Zellen einfärben
'3.Register einfärben
  vntFarben = Array(3, 45, 14, -4105) 'rot, gelb, grün,weiß,standard 2,
  AktuellesDatum = Date
'###1.Datum aktuallisieren
    'SpalteDurchlaufen
'!!!!!!!Hier bleibt er hängen!!!!!
    For Each Zelle In WkSh_ZB.Sheets(tabReg).Range(Cells(gefunden, Spalte), Cells(letzteBzeile1, Spalte))
'Der funzt
'For Each Zelle In WkSh_ZB.Sheets(tabReg).Range("H10:H50")
     
      If Zelle <> "" Then
        datfirst = Zelle.Value                                          'Schreibe in Zelle
            strWieviel = Zelle.Offset(0, -2)                            'die Anzahl der Monate
            If strWieviel > 0 Then
                datsecond = DateAdd("m", strWieviel, datfirst)          'DateAdd(Year(datfirst), Month(datfirst) + strWieviel, Day(datafirst))
                  Zelle.Offset(0, -1) = datsecond
            End If
        End If
      Next
'###2.Zellen einfärben
'SpalteDurchlaufen
            For Each Zelleeinf In WkSh_ZB.Sheets(tabReg).Range(Cells(gefunden, 7), Cells(letzteBzeile1, 7))    '("G10:G50")
            If Zelleeinf.Offset(0, -1) > 0 Then
                If Zelleeinf <> "" Then
                  If Zelleeinf <= Date Then                                                    'Werte vergleichen
                          Range(Zelleeinf.Offset(0, -5), Zelleeinf.Offset(0, -3)).Interior.ColorIndex = 3                      'Zellen rot einfärben
                          'Zelle.Offset(0, -4).Interior.ColorIndex = 3                      'Zelle rot einfärben
                          'Zelle.Offset(0, -3).Interior.ColorIndex = 3                      'Zelle rot einfärben
                      Else
                          Tage = (Zelleeinf - Date)                                            'Tage berechnen
                              If Tage <= 7 Then                                            'Abfrage 7 Tage vorher
                                      Range(Zelleeinf.Offset(0, -5), Zelleeinf.Offset(0, -3)).Interior.ColorIndex = 45        'Zellen gelb einfärben
                                      'Zelle.Offset(0, -4).Interior.ColorIndex = 45          'Zelle gelb einfärben
                                      'Zelle.Offset(0, -3).Interior.ColorIndex = 45          'Zelle gelb einfärben
                                  Else
                                      Range(Zelleeinf.Offset(0, -5), Zelleeinf.Offset(0, -3)).Interior.ColorIndex = xlNone      '-4105 'Zellen keine Farbe
                                      'Zelle.Offset(0, -4).Interior.ColorIndex = xlNone      '-4105 'Zelle keine Farbe
                                      'Zelle.Offset(0, -3).Interior.ColorIndex = xlNone      '-4105 'Zelle keine Farbe
                              End If
                  End If
                Else
                    If Zelleeinf.Offset(0, -1) <> "" Then                                      'wenn in Zelle daneben kein Werte dann
                        Range(Zelleeinf.Offset(0, -5), Zelleeinf.Offset(0, -3)).Interior.ColorIndex = 3                        'Zellen rot einfärben
                        'Zelle.Offset(0, -4).Interior.ColorIndex = 3                        'Zelle rot einfärben
                        'Zelle.Offset(0, -3).Interior.ColorIndex = 3                        'Zelle rot einfärben
                    End If
                End If
            End If
            Next


Wortgefunden = Wortgefunden + 1
                        With WkSh_ZB.Sheets(tabReg)
                        'Registerblatt einfärben
                        '          ###Neu###
                        'Im TabellenBlatt K2 wird die Farbe eingetragen
                        lz = IIf(IsEmpty(.Range("B65536")), .Range("B65536").End(xlUp).Row, 65536)
                          For lngC = 0 To UBound(vntFarben)
                            An = 10
                              For Each c In WkSh_ZB.Sheets(tabReg).Range(Cells(gefunden, 2), Cells(letzteBzeile1, 2))
                                If c.Interior.ColorIndex = vntFarben(lngC) Then
                                      If c.Interior.ColorIndex = -4105 Then GoTo weiter
                                        .Cells(Wortgefunden, 11).Interior.ColorIndex = vntFarben(lngC) 'K2
                                            Exit For
                                    Else
weiter:
                                      If WkSh_ZB.Sheets(tabReg).Cells(Wortgefunden, 11).Interior.ColorIndex = 14 Then
                                            Else
                                              WkSh_ZB.Sheets(tabReg).Cells(Wortgefunden, 11).Interior.ColorIndex = 14                      'Zelle grün einfärben
                                      End If
                                End If
                            An = An + 1
                              Next c
                                If An <= lz Then Exit For                                            'Prüfen ob c-Schleife abgebrochen wurde
                          Next lngC
                        End With

End If
Next i

Stop
'End With
'3. Schritt:
'Set rng = ActiveSheet.Range("A1:A" & letzteBzeile).Find("Wartungsplan")
Set rng = Nothing

End Sub
 
Was mache ich falsch oder übersehe ich was?
Bitte um HILFE und nicht auf das Netz verweisen, da habe ich schon seit Tagen gesucht und NICHTS gefunden!

Hallo Michael,

vieleicht so?

Gruß, Uwe

Hallo Michael,

hänge mal vor den Cells auch noch das Worksheet hin


PS: zu spät

Hallo

du hast ganz am Anfang nach den langen Dim Variablen, hinter "1. Schritt" diese Zeile stehen:
'With WkSh_ZB.Sheets(tabReg)   Warum bitte durch ' Zeichen deaktiviert???

Das verkürzt deinen Code viel übersichtlicher auf:    (Diese Zeile kommt bei dir ja mehrfach vor!)
For Each Zelle In .Range(.Cells(gefunden, Spalte), .Cells(letzteBzeile1, Spalte))

mfg  Gast 123

Vielen Dank für die schnelle Hilfe, 
Funktioniert super!

@ Gast 123 Das hatte ich zu Test zwecken so gemacht!