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

Loop makro

Loop makro
Joopy
Hallo
habe mal wieder ein Problem, das bestimmt schon tausendmal gefragt wurde, hab dazu auch schon einiges gelesen, aber die Infos auf meinen Fall umzusetzen ist mir doch nicht ganz gelungen...
Ich habe ein Tabellenblatt mit Projekt_ID Nummern in der zweiten spalte und den dazugehörigen Werten in der vierten Spalte. Der Datensatz ist nach unten flexibel, es können also neue Projekte hinzukommen/ wegfallen. Wichtig ist noch, dass einzelne Projektnummern häufiger vorkommen können und bis in den 4 stelligen Bereich gehen.
Nun enthält der Datensatz jedoch aktuelle und nicht aktuelle Projekte. Die aktuellen Projekt_ID's stehen auf Tabellenblatt 1 in der ersten Spalte, angefangen in Celle A1 bis A100
Ich bräuchte nun ein Makro welches die aktuellen Projekte mit dem Datensatz auf Tabellenblatt 2 abgleicht, und alle Zeilen, in welchen eine nicht übereinstimmende P_ID vorkommt, aus dem Datensatz löscht.
Ich bekomme irgendwie diese Loop -Geschichte nicht so hin, dass es richtig läuft. Wäre toll wenn Ihr mir einen Ansatz schicken könntet.

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Loop makro
05.08.2009 19:12:36
Tino
Hallo,
teste mal diesen Code, wenn ich Dich richtig verstanden habe sollte er funzen.
Die Tabellennamen noch anpassen.
Option Explicit

Sub Loesche_Alte_Projekte()
Dim iCalc As Integer
Dim Sh_Tabelle1 As Worksheet
Dim Sh_Tabelle2 As Worksheet

Set Sh_Tabelle1 = Sheets("Tabelle1") 'Deine Tabelle1 
Set Sh_Tabelle2 = Sheets("Tabelle2") 'Deine Tabelle2 

With Application
 iCalc = .Calculation
 .ScreenUpdating = False
 .EnableEvents = False
 .Calculation = xlCalculationManual

    With Sh_Tabelle2
     With .UsedRange.Columns(.UsedRange.Columns.Count).Offset(0, 1)
        'Formel =WENN(ISTFEHLER(VERGLEICH($B1;Tabelle1!$A:$A;0));WAHR;ZEILE()) 
        .FormulaR1C1 = "=IF(ISERROR(MATCH(RC2," & Sh_Tabelle1.Name & "!C1,0)),TRUE,ROW())"
        Sh_Tabelle2.UsedRange.Sort .Cells(1, 1), xlAscending, , , , , , xlNo
        On Error Resume Next
        .Cells.SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
        On Error GoTo 0
        .EntireColumn.Delete
     End With
    End With
    
 .ScreenUpdating = True
 .EnableEvents = True
 .Calculation = iCalc
End With
End Sub
Gruß Tino
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige