Supportnet / Forum / Tabellenkalkulation

Hallo zusammen, habe folgendes Makro(Auszug), das ich gerne auf mehrere Blätter anwenden möchte. Bisher funktioniert es nur, wenn ich es auf jedes einzelne Blatt anwende. Hier werden Werte aus Spalte I mit denen aus Spalte G verglichen. Steht in Spalte I ein Wert, werden die Zellen F,G,H durchgestrichen. Hoffe ihr habt Ideen. Option Explicit Public Sub vergleichen() Dim lngI As Long, intWert As Integer Application.ScreenUpdating = False For lngI = 1 To Cells(Rows.Count, 1).End(xlUp).Row intWert = Application.WorksheetFunction. _ CountIf(Worksheets("11.15").Range("I:I"), Cells(lngI, 7).Value) If intWert > 0 Then Cells(lngI, 6).Font.Strikethrough = True Cells(lngI, 7).Font.Strikethrough = True Cells(lngI, 8).Font.Strikethrough = True End If Next lngI For lngI = 1 To Cells(Rows.Count, 1).End(xlUp).Row intWert = Application.WorksheetFunction. _ CountIf(Worksheets("11.35").Range("I:I"), Cells(lngI, 7).Value) If intWert > 0 Then Cells(lngI, 6).Font.Strikethrough = True Cells(lngI, 7).Font.Strikethrough = True Cells(lngI, 8).Font.Strikethrough = True End If Next lngI Application.ScreenUpdating = True End Sub

Hallo,

du musst deine entsprechenden Blätter auch einbinden.

Da entsprechende Angaben zu den Blättern fehlen, wäre es vielleicht mit einer For-Schleife zu machen

For i = (1.Blatt) to (letztes Blatt
Sheets(i).Select

und dann deine Anweisungen
zum Schluss

Nexi i

Gruß

Helmut

Hallo Helmut,

bin leider nicht so der Held, was VBA angeht. Hab's mal so versucht. War leider nix. kannst du mir zeigen, wo ich die Schleife einbinden muss?

Public Sub vergleichen()
Dim lngI As Long, intWert As Integer
Dim i As Integer
Application.ScreenUpdating = False
For i = (11.15) to (11.35)
Sheets(i).Select
For lngI = 1 To Cells(Rows.Count, 1).End(xlUp).Row
intWert = Application.WorksheetFunction. _
CountIf(Worksheets("11.15").Range("I:I"), Cells(lngI, 7).Value)
If intWert > 0 Then
Cells(lngI, 6).Font.Strikethrough = True
Cells(lngI, 7).Font.Strikethrough = True
Cells(lngI, 8).Font.Strikethrough = True
End If
Next lngI
For lngI = 1 To Cells(Rows.Count, 1).End(xlUp).Row
intWert = Application.WorksheetFunction. _
CountIf(Worksheets("11.35").Range("I:I"), Cells(lngI, 7).Value)
If intWert > 0 Then
Cells(lngI, 6).Font.Strikethrough = True
Cells(lngI, 7).Font.Strikethrough = True
Cells(lngI, 8).Font.Strikethrough = True
End If
Next lngI
Next i
Application.ScreenUpdating = True
End Sub

Hallo,

so funktioniert das nicht



Hier müsste z.B. stehen

For i = 15 to 35

Wenn es das Tabellenblatt 15 bis 35 ist

Leider sind deine Angaben nicht so, dass man dir direkt weiterhelfen kann.

Gruß

Helmut

Hallo,

Die Tabellenblätter heißen 11.15, 11.35, 12.35......40.91. Das sind Typenbezeichnungen.
Bekomme beim Ausführen die Fehlermeldung " Laufzeitfehler 9: Index außerhalb des gültigen Bereichs". Die Tabellen können/sollten nicht umbenannt werden. Ist das Problem dennoch mit einer Schleife lösbar?

Gruß
Martin

Hallo Martin,

probiers mal so.

Option Explicit

Public Sub vergleichen()
    Dim lngI As Long, lngN As Long, intWert As Integer
    Application.ScreenUpdating = False
    For lngN = 1 To Worksheets.Count
        For lngI = 1 To Cells(Rows.Count, 1).End(xlUp).Row
            intWert = Application.WorksheetFunction. _
                CountIf(Worksheets(lngN).Range("I:I"), Cells(lngI, 
7).Value)
            If intWert > 0 Then
                With Worksheets(lngI)
                    .Cells(lngI, 6).Font.Strikethrough = True
                    .Cells(lngI, 7).Font.Strikethrough = True
                    .Cells(lngI, 8).Font.Strikethrough = True
                End With
            End If
        Next lngI
    Next lngN
    Application.ScreenUpdating = True
End Sub

Gruß
Rainer

Hallo Rainer,

jetzt wird die Fehlermeldung "Variable nicht definiert" für IngN angezeigt. Mit String und Integer klappts auch nicht. Hast du eine Idee?

Hallo Martin,

da hast Du einen Schreibfehler eingebaut.

Die Variable heißt

lngN und nicht IngN

Schreibfehler vermeidet man indem man das Makro einfach kopiert und einfügt.

Gruß
Rainer

Hab dein Makro kopiert und die gleiche Fehlermeldung wie bei Helmuts Vorschlag: "Index ausserhalb des gültigen Bereichs"

Hallo Martin,

ich habe Dein Makro nur angepasst und bin davon ausgegangen, dass es im Urzustand lief.

Da ich kein Testobjekt habe, kann ich Dir leider nicht helfen.
Du könntest noch folgende Änderung durchführen.

Option Explicit

Public Sub vergleichen()
    Dim lngI As Long, lngN As Long, intWert As Integer
    Application.ScreenUpdating = False
    For lngN = 1 To Worksheets.Count
        For lngI = 1 To Cells(Rows.Count, 1).End(xlUp).Row
            intWert = Application.WorksheetFunction. _
                CountIf(Worksheets(lngN).Range("I:I"), _
                Worksheets(lngN).Cells(lngI, 7).Value)
            If intWert > 0 Then
                With Worksheets(lngI)
                    .Cells(lngI, 6).Font.Strikethrough = True
                    .Cells(lngI, 7).Font.Strikethrough = True
                    .Cells(lngI, 8).Font.Strikethrough = True
                End With
            End If
        Next lngI
    Next lngN
    Application.ScreenUpdating = True
End Sub

Gruß
Rainer

Hallo Martin,

ändere diese Zeile

With Worksheets(lngI)

in

With Worksheets(lngN)

Das war ein Fehler von mir.

Gruß
Rainer

hallo Rainer,

im Urzustand läuft das Makro. Ich muss halt jedes Tabellenblatt öffnen und das Makro ausführen. Mein Problem ist nur, dass ich das Makro gerne einmal für die komplette Datei ausführen möchte.

Ausschnitt der funktionsfähigen Version:

Option Explicit

Public Sub vergleichen()
Dim lngI As Long, intWert As Integer
Application.ScreenUpdating = False
For lngI = 1 To Cells(Rows.Count, 1).End(xlUp).Row
intWert = Application.WorksheetFunction. _
CountIf(Worksheets("11.15").Range("I:I"), Cells(lngI, 7).Value)
If intWert > 0 Then
Cells(lngI, 6).Font.Strikethrough = True
Cells(lngI, 7).Font.Strikethrough = True
Cells(lngI, 8).Font.Strikethrough = True
End If
Next lngI
For lngI = 1 To Cells(Rows.Count, 1).End(xlUp).Row
intWert = Application.WorksheetFunction. _
CountIf(Worksheets("11.35").Range("I:I"), Cells(lngI, 7).Value)
If intWert > 0 Then
Cells(lngI, 6).Font.Strikethrough = True
Cells(lngI, 7).Font.Strikethrough = True
Cells(lngI, 8).Font.Strikethrough = True
End If
Next lngI
Application.ScreenUpdating = True
End Sub


Kannst du damit was anfangen?

werd's damit mal versuchen. Danke

Das Ergebnis ist das gleiche, wie mit meiner Version. Der Code ist nur übersichtlicher. Muss aber immer noch jedes Blatt öffnen, um die Zellen durchzustreichen.
Ich lebe vorerst mal damit.

Danke an alle

Gruß

Hallo Martin,

der Code ist getestet und läuft.

Wenn das bei Dir nicht der Fall ist, solltest Du Deine Mappe mal hoch laden, ansonsten kann ich Dir nicht weiter helfen.

Gruß
Rainer

Hallo Rainer,

der Code läuft, jedoch nur für das jeweils aktive Blatt. Bei 8 Blättern muss ich das Makro also 8 mal ausführen. Mir wäre einmal für die ganze Datei lieber gewesen.
Hochladen kann ich die Datei nicht. Müsste eine ähnliche erstellen. Würde etwas dauern.

Gruß
Martin

Hallo Martin,

wenn Du keine Datei lieferst, dann muss ich es tun.

Allerdings haben alle Tabellen die gleichen Werte, aber zum Testen reicht das ja.
Ich hoffe Dein Problem ist damit gelöst.
Rückmeldung wäre schön.

http://www.datei-upload.eu/file.php?id=3344772d332898e3cd901a621090...

Gruß
Rainer

Da bin ich platt :-)
werde die Datei mal hochladen. Muss schauen ob ich es heute noch schaffe.

hier nun der Link der stark abgespeckten version

http://www.datei-upload.eu/file.php?id=aad6a5afc163b909d2592d9a3bbb880e

Hallo Martin,

- das Maklro gehört in ein allgemeines Modul und nicht in den Codebereich "DieseArbeitsmappe"

- in Deiner Datei befindet sich mein erstes Makro, richtig wäre das Makro aus Frage 9 mit der Änderung aus Frage 10

- in Deiner Datei befinden sich noch andere Tabellen außer denen, die Du auswerten willst, deshalb ist noch eine weitere Änderung erforderlich.
Füge alle weiteren auszuwertenden Tabellen vor der Tabelle "Abfrage geliefert" ein und füge vor den auszuwertenden Tabellen keine weiteren Tabellen ein.

Hier nun das funktionierende Makro.

Option Explicit

Public Sub vergleichen()
    Dim lngI As Long, lngN As Long, intWert As Integer
    Application.ScreenUpdating = False
    For lngN = 2 To Worksheets.Count - 1
        For lngI = 1 To Cells(Rows.Count, 1).End(xlUp).Row
            intWert = WorksheetFunction.CountIf(Worksheets(lngN).Range("I:I"), _
            Worksheets(lngN).Cells(lngI, 7).Value)
            If intWert > 0 Then
                With Worksheets(lngN)
                    .Cells(lngI, 6).Font.Strikethrough = True
                    .Cells(lngI, 7).Font.Strikethrough = True
                    .Cells(lngI, 8).Font.Strikethrough = True
                End With
            End If
        Next lngI
    Next lngN
    Application.ScreenUpdating = True
End Sub

Gruß
Rainer

Hallo Rainer,

werde das morgen mal ausprobieren. Melde mich dann nochmal. Danke im Voraus.

Gruß
Martin

Hallo Rainer,

habe deinen Code aus 9 mit Änderungen aus 10 in ein allgemeines Modul eingefügt und es funktioniert soweit. Mit der Änderung in Antwort 19 habe ich es nicht zum Laufen gebracht.
Danke für die Hilfe.

Gruß martin

Hallo Martin,

das Makro ist in Deiner Datei getestet und läuft.

Wenn es bei Dir nicht läuft, hast Du nicht beachtet, was ich Dir geschrieben habe.

Gruß
Rainer

Hallo Rainer,

meinte damit eigentlich, dass alles so ist wie es sein soll. Die Datei komplett abgedeckt.

Gruß
Martin

• excel2000 Blätter in bestehende Arbeitsmappe einfügen
• excel-umbenannte Blätter - Verknüpfung
• Eingabe auf Formel anwenden
• Verschieben von Zeilen in Blätter mit Namensprinzip
• Datumsabfrage über mehrere Blätter