Fehlermeldung nicht nachvollziehbar

Sub Filtern() Dim cell, Zielzelle As Range For Each cell In Range("A:A").SpecialCells(xlCellTypeConstants) If cell.Value = "V1" Or cell.Value = "V2" Or cell.Value = "V3" Or cell.Value = "V4" Or _ cell. _ Value = "V5" Then Set Zielzelle = Range("1:1").Find(cell.Value) If Year(Zielzelle.Offset(cell.Row - 1, 1)) & Format(Month(Zielzelle.Offset(cell.Row - _ _ _ 1, _ 1)), "0#")

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Werner,
sorry für die verspäte Rückmeldung.
Besten Dank für deinen Code.
Nach ausführen hat er eine Fehlermeldung gebracht, weil "loLetzteZ" anscheinend nicht deklariert war. Habe dann Dim loLetzteZ As Long deklariert. Danach hat es funktioniert.
Suchbereich und Suchtext habe ich angepasst/geändert - Von Vx zu ILx (Plan)-.
Soll dich nicht durcheinander bringen.
Option Explicit

Sub Filtern()
Dim raZelle As Range, raZielzelle As Range
Dim daDatum As Date, loLetzte As Long
daDatum = DateSerial(Year(Date), Month(Date) + 1, Day(Date))
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
For Each raZelle In .Range("M4:M" & loLetzte).SpecialCells(xlCellTypeConstants)
Select Case raZelle.Value
Case "IL2 (Plan)", "IL3 (Plan)", "IL4 (Plan)", "IL4 (Plan)"
Set raZielzelle = .Range("2:2").Find(what:=raZelle.Value, _
LookIn:=xlValues, lookat:=xlPart)
If Not raZielzelle Is Nothing Then
If .Cells(raZelle.Row, raZielzelle.Column + 1)

Jedoch wird keine einzige Zeile Gelb gefärbt und in den zweiten Arbeitsblatt werden keine richtigen Zeilen aufgelistet.
Ich habe nun die große Pivot Tabelle nahezu 1:1 nachgestellt.
Gerne würde ich diese hier hochladen wollen, jedoch Sie übersteigt die max. Grenze von 300 KB. Die nachgestellte Datei ist 923 KB groß.
Ich würde die Datei dir gerne als PN schicken, wenn du damit einverstanden wärst oder es dir irgendwie anderst zukommen lassen?
VB
Memo
Kann ich Sie

Set Zielzelle = Range("1:1").Find(what:=cell.Value, lookin:=xlvalues, lookat:=xlPart) If not Zielzelle Is Nothing Then 'hier der weitere Code bei Treffer Else Msgbox "Der Suchbegriff ist nicht vorhanden." End If

Sub Filtern() Dim cell, Zielzelle As Range For Each cell In Range("M:M").SpecialCells(xlCellTypeConstants) If cell.Value = "V1" Or cell.Value = "V2" Or cell.Value = "V3" Or cell.Value = "V4" Or _ cell. _ Value = "V5" Then Set Zielzelle = Range("2:2").Find(cell.Value) If Year(Zielzelle.Offset(cell.Row - 1, 1)) & Format(Month(Zielzelle.Offset(cell.Row - _ 1, _ 1)), "0#")

Sub Filtern() Dim raZelle As Range, raZielzelle As Range Dim daDatum As Date daDatum = DateSerial(Year(Date), Month(Date) + 1, Day(Date)) Application.ScreenUpdating = False For Each raZelle In Range("M:M").SpecialCells(xlCellTypeConstants) Select Case raZelle.Value Case "V1", "V2", "V3", "V4", "V5" Set raZielzelle = Range("2:2").Find(what:=raZelle.Value, _ LookIn:=xlValues, lookat:=xlPart) If Not raZielzelle Is Nothing Then If Year(raZielzelle.Offset(raZelle.Row - 1, 1))

Hi Werner,
danke für die Rückmeldung.
Dein Code habe ich direkt über die originale Pivot Tabelle laufen lassen.
Es wird zwar ausgeführt, aber keine einzige Zeile wird gelb hervorgehoben.
Dein Code funktioniert tadellos in einer stinknormalen Excel file. Ich habe sogar 1600 Zeilen kopiert und eingefügt. Darunter sollten exakt 798 Zeilen gelb markiert werden, das tut dein Code tadellos.
Jedoch funktioniert derselbe Code mit derselben Angaben/Bereichvorgaben leider nicht in der blöden Pivot.
Der zu analysierende Bereich ist ja nur 2187 Zeilen. In der Pivot tut sich aber leider nichts.
Ich wollte sogar die Pivot komplett kopieren und als Werte in eine neue excel ohne markos einfügen.
Aber beim einfügen werden nicht alle 2187 zeilen eingefügt, egal wie ich es anstelle, obwohl ich komplett alles kopiere.
Nun stehe ich vor ein neues Problem.
Ich würde aber sehr gerne Wissen wollen, warum ein tadellos funktionierender VBA Code nicht in einer Pivot oder in dieser Pivot funkt bzw. wie ich diese Pivot mit den exakten Inhalt reproduzieren kann ohne Datenverlust?
Danke für deine Unterstützung.
VG
Memo

Sub Filtern() Dim raZelle As Range, raZielzelle As Range Dim daDatum As Date, loLetzte As Long daDatum = DateSerial(Year(Date), Month(Date) + 1, Day(Date)) Application.ScreenUpdating = False With Worksheets("Tabelle1") loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row For Each raZelle In .Range("A4:A" & loLetzte).SpecialCells(xlCellTypeConstants) Select Case raZelle.Value Case "V1", "V2", "V3", "V4", "V5" Set raZielzelle = .Range("2:2").Find(what:=raZelle.Value, _ LookIn:=xlValues, lookat:=xlPart) If Not raZielzelle Is Nothing Then If .Cells(raZelle.Row, raZielzelle.Column + 1)

Sub Filtern() Dim raZelle As Range, raZielzelle As Range Dim daDatum As Date, loLetzte As Long daDatum = DateSerial(Year(Date), Month(Date) + 1, Day(Date)) Application.ScreenUpdating = False With Worksheets("Tabelle1") loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row For Each raZelle In .Range("M4:M" & loLetzte).SpecialCells(xlCellTypeConstants) Select Case raZelle.Value Case "IL2 (Plan)", "IL3 (Plan)", "IL4 (Plan)", "IL4 (Plan)" Set raZielzelle = .Range("2:2").Find(what:=raZelle.Value, _ LookIn:=xlValues, lookat:=xlPart) If Not raZielzelle Is Nothing Then If .Cells(raZelle.Row, raZielzelle.Column + 1)

Beliebteste Forumthreads (12 Monate)

Fehlermeldung nicht nachvollziehbar

24 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

24
Beiträge zum Forumthread

Beiträge zu diesem Forumthread