Excel: Zeilen zw. Start und Ende löschen

Dieses Thema Excel: Zeilen zw. Start und Ende löschen im Forum "Microsoft Office Suite" wurde erstellt von MichiMuc, 7. Juli 2006.

Thema: Excel: Zeilen zw. Start und Ende löschen Guten Tag, ich habe ein Excelproblem. Ich habe eine riesige Tabelle, in der viele Zeilen doppelt vorkommen, d.h. der...

  1. Guten Tag,
    ich habe ein Excelproblem. Ich habe eine riesige Tabelle, in der viele Zeilen doppelt vorkommen, d.h. der selbe Wert in Spalte C.
    Es sollen alle Zeilen gelöscht werden, die doppelt vorkommen, außer der erste und der letzte der jeweiligen Gruppe.

    In Spalte C steht zum Beispiel:
    Zeile 1: München
    Zeile 2: München
    Zeile 3: München
    Zeile 4: München
    Zeile 5: München

    Das Makro sollte die Zeilen 2 - 4 löschen, da in Spalte A eine Zeit steht und ich die Aufenthaltsdauer in München ermitteln möchte.

    Wäre super, wenn mir jemand helfen könnte,
    Michael.
     
  2. Hallo MichiMuc,

    probier mal das Makro, ob es das Gewünschte tut. Ggf. noch die Konstante cABZEILE anpassen.

    Mit der Konstanten cTEST kannst du einstellen, ob es die relevanten Zeilen löschen oder nur rot einfärben soll.
    Momentan ist cTEST = True , also nur rot einfärben (zum Testen).
    Das müßtest du nach dem Test ändern in:  cTEST = False

    Gruß Matjes :)
    Code:
    Sub Excel_SpalteCGruppenAnfEndeZeileStehenLassen()
    '*** Sucht Gruppen gleicher Begriffe in Spalte C
    '*** Von den Zeilen der Gruppe werden alle Zeilen
    '*** außer der 1. und letzten Zeile gelöscht
    
     Const cTEST = True->Schalter Test
              ->true: zu löschende Zeilen werden nur rot markiert
              ->false: zu löschende Zeilen werden gelöscht
               
     Const cABZEILE = 2->Zeile ab der Gruppen gesucht werden sollen
     Const cSPC = 3  ->Suchspalte C
    
     Dim ws As Worksheet
     Dim lLetzteZeile As Long, lLetzteSpalte As Long
     Dim ze As Long, za As Long, x As Long
     
     Set ws = ActiveSheet
     With ws
     
      lLetzteSpalte = .UsedRange.Column + .UsedRange.Columns.Count - 1
      lLetzteZeile = .UsedRange.Row + .UsedRange.Rows.Count - 1
      
      ze = lLetzteZeile
      
      Do While ze > cABZEILE
       
      ->*** nächste Ende-Zeile einer Gruppe suchen
       Do While ze > cABZEILE
       ->Zelle nicht leer ?
        If .Cells(ze, cSPC).Value <>  Then Exit Do->Ende-Zeile gefunden
       ->nächste Zeile
        ze = ze - 1
       Loop
       
      ->*** keine Ende-Zeile mehr vorhanden ? ->
       If Not (ze > cABZEILE) Then Exit Do
       
      ->*** Anfangs-Zeile dieser Gruppe bestimmen
       za = ze
       Do While (za > cABZEILE)
        za = za - 1
       ->anderer Begriff ?
        If .Cells(za, cSPC).Value <> .Cells(ze, cSPC).Value Then
         za = za + 1
         Exit Do
        End If
       Loop
      
      ->*** ggf. Zwischen-Zeilen in dieser Gruppe löschen
       For x = (ze - 1) To (za + 1) Step -1
       ->Testbetrieb ?
        If cTEST Then
        ->Zellen der zu löschenden Zeile rot markieren
         .Range(.Cells(x, 1), .Cells(x, lLetzteSpalte)).Interior.ColorIndex = 3
        Else
        ->Zeile löschen
         .Rows(x).Delete
        End If
       Next
       
      ->*** nächsten Suchanfang setzen
       ze = za - 1
      Loop
    
     End With
    AUFRAEUMEN:
     Set ws = Nothing
    End Sub
     
  3. Hallo Matjes.
    Vielen Dank, es funktioniert super. Ich will ja nicht unverschämt sein, aber dürfte ich Dich wohl noch um eine kleine Modifizierung bitten?

    Ich hätte gerne noch, dass die Anfangszeile in grüner Schrift, die Endezeile in roter Schrift und Zeilen die nur ein Mal vorkommen (weder Anfangs-, noch Endpunkt, noch doppelt) in schwarz bleiben.

    Außerdem würde ich gerne in Spalte J automatisch eine Formel eintragen lassen...

    Ich hoffe, Du hast noch Lust. Vielen Dank,
    Michael.
     
  4. Und welcher Art darf die sein  ;D

    Du meinst schwarz, wenn in eine Gruppe nur aus einer zeile besteht ?

    Gruß Matjes :)
     
  5. In Spalte A steht ein Datum und in Spalte B eine Uhrzeit. In der Spalte J soll dann der Zeitraum zwischen Start- und Endpunkt berechnet werden. Ich möchte anschließend nach diesem Zeitraum die Daten ausfiltern. Also z.B. nur Orte anzeigen, an denen sich das Fahrzeug länger als 20 Minuten aufgehalten hat.
    Ich denke dazu eignet sich der Filter von Excel oder? Diesen möchte ich dann beim Öffnen des Dokuments vom User einstellen lassen. Vielleicht mittels Userform.

    Ja, genau. Sozusagen Punkte, die auf dem Weg liegen.


    Nochmal danke,
    Michael.
     
  6. Dann Release 2  ;D

    Gruß Matjes :)
    Code:
    Sub Excel_SpalteCGruppenAnfEndeZeileStehenLassen()
    '*** Sucht Gruppen gleicher Begriffe in Spalte C
    '***
    '*** Von den Zeilen der Gruppe werden alle Zeilen
    '*** außer der 1. und letzten Zeile gelöscht
    '***
    '*** Hat die Gruppe nur eine Zeile bleibt die Zeile unverändert
    '*** Hat die Gruppe mehr als 1 Zeile, wird
    '***  - in der ersten  Zeile die Schrift grun
    '***  - in der letzten Zeile die Schrift rot
    '*** gesetzt. Dann wird auch die Zeitdifferenz in Spalte J gesetzt.
    '*** (Spalte A: Datum, Spalte B: Uhrzeit
    
      Const cTEST = True ->Schalter Test
                         ->true:  zu löschende Zeilen werden nur rot markiert
                         ->false: zu löschende Zeilen werden gelöscht
                         
      Const cABZEILE = 2 ->Zeile ab der Gruppen gesucht werden sollen
      Const cSPA = 1     ->Spalte Datum
      Const cSPB = 2     ->Spalte Uhrzeit
      Const cSPC = 3     ->Suchspalte C
      Const cSPJ = 10     'Spalte Zeitdifferenz in Minuten zwischen Anf-und Ende-Zeile
      Const cCIROT = 3   ->Farbindex rot
      Const cCIGRUEN = 50->Farbindex gruen (Meeresgrün)
      Const cCIGELB = 6   'Farbindex gelb
    
      Dim ws As Worksheet
      Dim lLetzteZeile As Long, lLetzteSpalte As Long
      Dim ze As Long, za As Long, x As Long
      Dim lMinuten As Long
      
      Set ws = ActiveSheet
      With ws
      
        lLetzteSpalte = .UsedRange.Column + .UsedRange.Columns.Count - 1
        lLetzteZeile = .UsedRange.Row + .UsedRange.Rows.Count - 1
        
        ze = lLetzteZeile
        
        Do While ze > cABZEILE
          
         ->*** nächste Ende-Zeile einer Gruppe suchen
          Do While ze > cABZEILE
           ->Zelle nicht leer ?
            If .Cells(ze, cSPC).Value <>  Then Exit Do->Ende-Zeile gefunden
           ->nächste Zeile
            ze = ze - 1
          Loop
          
         ->*** keine Ende-Zeile mehr vorhanden ? ->
          If Not (ze > cABZEILE) Then Exit Do
          
         ->*** Anfangs-Zeile dieser Gruppe bestimmen
          za = ze
          Do While (za > cABZEILE)
            za = za - 1
           ->anderer Begriff ?
            If .Cells(za, cSPC).Value <> .Cells(ze, cSPC).Value Then
              za = za + 1
              Exit Do
            End If
          Loop
        
         ->ggf. Schrift-Farbe setzen, wenn Gruppe mehr als eine Zeile hat
         ->und Zeitdifferenz in Spalte J
          If za <> ze Then
            .Range(.Cells(za, 1), .Cells(za, lLetzteSpalte)).Font.ColorIndex = cCIGRUEN
            .Range(.Cells(ze, 1), .Cells(ze, lLetzteSpalte)).Font.ColorIndex = cCIROT
            lMinuten = ZeitdifferenzInMinuten(ws, za, ze, cSPA, cSPB)
            If lMinuten < 9999 Then
              .Cells(za, cSPJ).Value = lMinuten
              .Cells(ze, cSPJ).Value = lMinuten
            Else
              .Cells(za, cSPJ).Value = FEHLER
              .Cells(ze, cSPJ).Value = FEHLER
            End If
          End If
          
         ->*** ggf. Zwischen-Zeilen in dieser Gruppe löschen
          For x = (ze - 1) To (za + 1) Step -1
           ->Testbetrieb ?
            If cTEST Then
             ->Zellen der zu löschenden Zeile rot markieren
              .Range(.Cells(x, 1), .Cells(x, lLetzteSpalte)).Interior.ColorIndex = cCIGELB
            Else
             ->Zeile löschen
              .Rows(x).Delete
            End If
          Next
          
         ->*** nächsten Suchanfang setzen
          ze = za - 1
        Loop
    
      End With
    AUFRAEUMEN:
      Set ws = Nothing
    End Sub
    '**********************************************************************************
    
    Private Function ZeitdifferenzInMinuten(ws As Worksheet, _
                                            za As Long, ze As Long, _
                                            SPDatum As Long, SPUhrzeit As Long) As Long
     ->*** Berechnung der Zeitdifferenz in Minuten
     ->*** bei Fehler wird eine zeitdifferenz > 9999 zurückgeliefert
      
      Dim dDateDatum_za As Date, dDateUhrzeit_za As Date
      Dim dDateDatum_ze As Date, dDateUhrzeit_ze As Date
      Dim lStunde As Long, lMinute As Long
      Dim dZeitdifferenz As Date
      
      On Error Resume Next
      ZeitdifferenzInMinuten = 100000
      
     ->*** Anfangszeit
      If ws.Cells(za, SPDatum).Value =  Then Exit Function
      dDateDatum_za = ws.Cells(za, SPDatum).Value
      If Err.Number <> 0 Then Err.Clear: Exit Function
      
      If ws.Cells(za, SPUhrzeit).Value =  Then Exit Function
      dDateUhrzeit_za = ws.Cells(za, SPUhrzeit).Value
      If Err.Number <> 0 Then Err.Clear: Exit Function
      
      lStunde = Hour(dDateUhrzeit_za)
      lMinute = Minute(dDateUhrzeit_za)
      dDateDatum_za = DateAdd(h, lStunde, dDateDatum_za)
      dDateDatum_za = DateAdd(n, lMinute, dDateDatum_za)
    
      
     ->*** Endezeit
      If ws.Cells(ze, SPDatum).Value =  Then Exit Function
      dDateDatum_ze = ws.Cells(ze, SPDatum).Value
      If Err.Number <> 0 Then Err.Clear: Exit Function
      
      If ws.Cells(ze, SPUhrzeit).Value =  Then Exit Function
      dDateUhrzeit_ze = ws.Cells(ze, SPUhrzeit).Value
      If Err.Number <> 0 Then Err.Clear: Exit Function
      
      lStunde = Hour(dDateUhrzeit_ze)
      lMinute = Minute(dDateUhrzeit_ze)
      dDateDatum_ze = DateAdd(h, lStunde, dDateDatum_ze)
      dDateDatum_ze = DateAdd(n, lMinute, dDateDatum_ze)
      
    
     ->*** Zeitdifferenz
      If dDateDatum_ze < dDateDatum_za Then Exit Function
      ZeitdifferenzInMinuten = DateDiff(n, dDateDatum_za, dDateDatum_ze)
    
    End Function
     
  7. Hey Matjes.
    Vielen Dank, dass ist ja der Hammer. Super! Genau was ich brauche. Und das in der Geschwindigkeit. Tausend Dank.
    Michael.
    Wirklich perfekt.
     
Die Seite wird geladen...

Excel: Zeilen zw. Start und Ende löschen - Ähnliche Themen

Forum Datum
Wie kann ich eine Excel-Formel in die nachfolgenden Zeilen mit variablem Multiplikator ziehen ? Microsoft Office Suite 4. Dez. 2015
Excel VBA Makro zum suchen und markieren von Zeilen die ein bestimmtes Wort enthalten Microsoft Office Suite 16. Juni 2014
Zeilen Löschen im Excel Windows XP Forum 4. Okt. 2013
Excel - Bestimmte Daten (Zeilen) in ein anderes Tabellenblatt einfügen Windows XP Forum 7. Juli 2012
Excel 2007. Nichtbenötigte Zeilen und Spalten entfernen. Microsoft Office Suite 30. März 2012