Office: (Office 2016) Tabellen zusamenkürzen

Helfe beim Thema Tabellen zusamenkürzen in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; @RPP63 : Hallo Ralf, ich hatte deinen Lösungsvorschlag schon versucht. Leider habe ich eine Rückmeldung versäumt, sry :-( Ich bin auf 2 Probleme... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von suey, 11. Januar 2021.

  1. suey
    suey User

    Tabellen zusamenkürzen


    @RPP63 : Hallo Ralf, ich hatte deinen Lösungsvorschlag schon versucht. Leider habe ich eine Rückmeldung versäumt, sry :-(
    Ich bin auf 2 Probleme gestoßen.
    Zum Einen kann ich deine Excel-Tabelle nicht herunterladen, weil ich auf meinem Arbeitsrechner dazu keine Berechtigung habe. Das könnte ich allerdings von zuhause machen.
    Das größere Problem ist, dass eine Umwandlung der 6 MB großen Tabelle nach 1.048.000 geladenen Zeilen abgebrochen wird und mir eine Fehlermeldung mitteilt, dass mein Arbeitsspeicher von 8 GB nicht ausreichen würde ...
    Könnte aber auch das zuhause mit 64 GB noch mal versuchen :-)

    @Beverly : Hi Beverly, die eigentliche Tabelle kann ich nicht hochladen, weil sie personenbezogene Daten enthält und recht groß ist. Ich habe mal die obere linke Ecke der ersten Haupttabelle rauskopiert und hier hochgeladen. Ich hoffe, das ist ausreichend.
    Ich will nach den Kursen "Pmd", "Pkt" und "PrW" suchen. Bei diesen hätte ich gerne in der per Makro neu zu erstellenden Tabelle gewusst, welche Gruppen (mit wie vielen Teilnehmern - die Zahl links daneben) an welchem Tag einen dieser Kurse besuchen / besucht haben.

    Ich finde es übrigens großartig, wie ihr euch hier kümmert !

    LG
     
    1 Person gefällt das.
  2. Beverly
    Beverly Erfahrener User
    Die hochgeladene Mappe war ausreichend um deinen Tabellenaufbau nachvollziehen zu können. Mit dem folgenden Code sollte es jetzt funktionieren:

    Code:
    Sub Zusammenfassen()
        Dim intSpalte As Integer
        Dim lngZeile As Long
        Dim intLetzte As Integer
        Dim lngLetzte As Long
        Application.ScreenUpdating = False
        ActiveSheet.Copy after:=ActiveSheet
        With ActiveSheet
            lngLetzte = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            intLetzte = .Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            .Range(.Cells(1, 8), .Cells(lngLetzte, intLetzte)).Copy
            .Range("H1").PasteSpecial Paste:=xlValues
            For lngZeile = lngLetzte To 6 Step -1
                If .Cells(lngZeile, 2) <> "" Then
                    If Application.CountIf(.Range(.Cells(lngZeile, 8), .Cells(lngZeile, intLetzte)), "Pkt") = 0 _
                        And Application.CountIf(.Range(.Cells(lngZeile, 8), .Cells(lngZeile, intLetzte)), "Pmd") = 0 _
                        And Application.CountIf(.Range(.Cells(lngZeile, 8), .Cells(lngZeile, intLetzte)), "PrW") = 0 _
                        Then
                        .Rows(lngZeile).Delete
                    End If
                End If
            Next lngZeile
            For intSpalte = intLetzte To 8 Step -1
                If Application.CountIf(.Range(.Cells(6, intSpalte), .Cells(lngLetzte, intSpalte)), "Pkt") = 0 _
                    And Application.CountIf(.Range(.Cells(6, intSpalte), .Cells(lngLetzte, intSpalte)), "Pmd") = 0 _
                    And Application.CountIf(.Range(.Cells(6, intSpalte), .Cells(lngLetzte, intSpalte)), "Prw") = 0 _
                    Then
                    .Columns(intSpalte).Delete
                End If
            Next intSpalte
        End With
        Application.ScreenUpdating = True
    End Sub
    
    Beachte, dass der Tabellenkopf keine Formeln mehr enthält sondern diese in Werte umgewandelt werden weil andernfalls dort Bezugsfehler auftreten, da ja Spalten gelöscht werden müssen und die Formeln keinen Bezug auf vorhergehende Spalten mehr nehmen können.


    Tabellen zusamenkürzen GrußformelTabellen zusamenkürzen Beverly's Excel - Inn
     
    Beverly, 12. Januar 2021
    #17
    2 Person(en) gefällt das.
  3. suey
    suey User
    Danke Beverly. Ich bin allerdings erst am Donnerstag wieder an meinem Arbeitsrechner und kann es ausprobieren. Ich melde mich dann.
     
  4. suey
    suey User

    Tabellen zusamenkürzen

    Es klappt ! Der Code macht genau, was ich wollte.
    Ich freu mich :-)
    Vielen vielen Dank !!!
     
    1 Person gefällt das.
  5. suey
    suey User
    Hi,
    ich habe den Code an einer größeren Beispieltabelle getestet und versucht, ihn auf 5 unterschiedliche Kurse zu erweitern. Das Ergebnis hat mich etwas überrascht. In der im Anhang hochgeladenen Tabelle werden z.B. die Gruppe 17 und der 03.01.2021 fälschlich angezeigt, obwohl dort keine Kurse 1-5 stattfinden. Dafür wurde die Zeilen der Gruppen 5 - 9 gelöscht, obwohl sie Kurse enthalten.
    Habe ich da was vermurkst und man kann den Code nicht einfach so erweitern?
    Code:
    Sub Zusammenfassen()
        Dim intSpalte As Integer
        Dim lngZeile As Long
        Dim intLetzte As Integer
        Dim lngLetzte As Long
        Application.ScreenUpdating = False
        ActiveSheet.Copy after:=ActiveSheet
        With ActiveSheet
            lngLetzte = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            intLetzte = .Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            .Range(.Cells(1, 8), .Cells(lngLetzte, intLetzte)).Copy
            .Range("H1").PasteSpecial Paste:=xlValues
            For lngZeile = lngLetzte To 6 Step -1
                If .Cells(lngZeile, 2) <> "" Then
                    If Application.CountIf(.Range(.Cells(lngZeile, 8), .Cells(lngZeile, intLetzte)), "Kurs 1") = 0 _
                        And Application.CountIf(.Range(.Cells(lngZeile, 8), .Cells(lngZeile, intLetzte)), "Kurs 2") = 0 _
                        And Application.CountIf(.Range(.Cells(lngZeile, 8), .Cells(lngZeile, intLetzte)), "Kurs 3") = 0 _
                        And Application.CountIf(.Range(.Cells(lngZeile, 8), .Cells(lngZeile, intLetzte)), "Kurs 4") = 0 _
                        And Application.CountIf(.Range(.Cells(lngZeile, 8), .Cells(lngZeile, intLetzte)), "Kurs 5") = 0 _
                        Then
                        .Rows(lngZeile).Delete
                    End If
                End If
            Next lngZeile
            For intSpalte = intLetzte To 8 Step -1
                If Application.CountIf(.Range(.Cells(6, intSpalte), .Cells(lngLetzte, intSpalte)), "Kurs 1") = 0 _
                    And Application.CountIf(.Range(.Cells(6, intSpalte), .Cells(lngLetzte, intSpalte)), "Kurs 2") = 0 _
                    And Application.CountIf(.Range(.Cells(6, intSpalte), .Cells(lngLetzte, intSpalte)), "Kurs 3") = 0 _
                    And Application.CountIf(.Range(.Cells(6, intSpalte), .Cells(lngLetzte, intSpalte)), "Kurs 4") = 0 _
                    And Application.CountIf(.Range(.Cells(6, intSpalte), .Cells(lngLetzte, intSpalte)), "Kurs 5") = 0 _
                    Then
                    .Columns(intSpalte).Delete
                End If
            Next intSpalte
        End With
        Application.ScreenUpdating = True
    End Sub
    LG
     
  6. Beverly
    Beverly Erfahrener User
    Hi,

    wenn du einen anderen Tabellenaufbau hast, musst du die Startspalten und -zeilen natürlich anpassen:

    Code:
    Sub Zusammenfassen()
        Dim intSpalte As Integer
        Dim lngZeile As Long
        Dim intLetzte As Integer
        Dim lngLetzte As Long
        Application.ScreenUpdating = False
        ActiveSheet.Copy after:=ActiveSheet
        With ActiveSheet
            lngLetzte = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            intLetzte = .Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            .Range(.Cells(1, 1), .Cells(lngLetzte, intLetzte)).Copy
            .Range("A1").PasteSpecial Paste:=xlValues
            For lngZeile = lngLetzte To 2 Step -1
                If .Cells(lngZeile, 1) <> "" Then
                    If Application.CountIf(.Range(.Cells(lngZeile, 2), .Cells(lngZeile, intLetzte)), "Kurs 1") = 0 _
                        And Application.CountIf(.Range(.Cells(lngZeile, 2), .Cells(lngZeile, intLetzte)), "Kurs 2") = 0 _
                        And Application.CountIf(.Range(.Cells(lngZeile, 2), .Cells(lngZeile, intLetzte)), "Kurs 3") = 0 _
                        And Application.CountIf(.Range(.Cells(lngZeile, 2), .Cells(lngZeile, intLetzte)), "Kurs 4") = 0 _
                        And Application.CountIf(.Range(.Cells(lngZeile, 2), .Cells(lngZeile, intLetzte)), "Kurs 5") = 0 _
                        Then
                        .Rows(lngZeile).EntireRow.Delete
                    End If
                End If
            Next lngZeile
            For intSpalte = intLetzte To 2 Step -1
                If Application.CountIf(.Range(.Cells(2, intSpalte), .Cells(lngLetzte, intSpalte)), "Kurs 1") = 0 _
                    And Application.CountIf(.Range(.Cells(2, intSpalte), .Cells(lngLetzte, intSpalte)), "Kurs 2") = 0 _
                    And Application.CountIf(.Range(.Cells(2, intSpalte), .Cells(lngLetzte, intSpalte)), "Kurs 3") = 0 _
                    And Application.CountIf(.Range(.Cells(2, intSpalte), .Cells(lngLetzte, intSpalte)), "Kurs 4") = 0 _
                    And Application.CountIf(.Range(.Cells(2, intSpalte), .Cells(lngLetzte, intSpalte)), "Kurs 5") = 0 _
                    Then
                    .Columns(intSpalte).EntireColumn.Delete
                End If
            Next intSpalte
        End With
        Application.ScreenUpdating = True
    End Sub
    

    Tabellen zusamenkürzen GrußformelTabellen zusamenkürzen Beverly's Excel - Inn
     
    Beverly, 18. Januar 2021
    #21
  7. suey
    suey User
    @Beverly : Sry, dass ich mich erst jetzt melde, ich konnte mich erst heute wieder der Excel-Problematik zuwenden :-)

    Ich hatte diese Testtabelle am Montag erzeugt, weil ich versuchen wollte herauszufinden, warum dein Code vom 12.12.2021 für mich nur teilweise funktioniert. Ich habe alles Mögliche rumprobiert, aber mir fehlt irgend wie das tiefere Verständnis für VBA ;-)

    Folgendes funktioniert in meiner große Tabelle nicht:
    Wenn ich das Makro starte, werden nur die relevanten Spalten gelöscht, nicht aber die Zeilen.

    Ich habe mal eine bereinigte Fassung meiner großen Tabelle hier angehängt. Das Makro ist schon eingefügt, das Ergebnis nach dem Ausführen ist auf dem 2. Blatt. Die für mich relevanten Zellen (mit den Inhalten Pkt, Pdm oder PrW) sind rot unterlegt. Man kann sehen, dass auf Blatt 2 alle Spalten gelöscht wurden, die keine rot markierten Zellen haben. Die 398 Zeilen sind aber alle noch da, obwohl gerade im unteren Bereich viele Zeilen keine relevanten Inhalte haben.

    Ich weiß nicht mehr weiter ...
     
  8. Beverly
    Beverly Erfahrener User

    Tabellen zusamenkürzen

    Hi,

    deine ursprünglich hochgeladene Mappe implizierte, dass nur die Zeilen bearbeitet werden sollen, in denen in Spalte B (2) ein Inhalt vorhanden ist - das berücksichtigt dieser Codeteil:

    Code:
            For lngZeile = lngLetzte To 6 Step -1
                If .Cells(lngZeile, 2) <> "" Then '<== Zeile weglassen
                    If Application.CountIf(.Range(.Cells(lngZeile, 8), .Cells(lngZeile, intLetzte)), "Pkt") = 0 _
                        And Application.CountIf(.Range(.Cells(lngZeile, 8), .Cells(lngZeile, intLetzte)), "Pmd") = 0 _
                        And Application.CountIf(.Range(.Cells(lngZeile, 8), .Cells(lngZeile, intLetzte)), "PrW") = 0 _
                        Then
                        .Rows(lngZeile).Delete
                    End If
                End If '<== Zeile weglassen
            Next lngZeile
    
    Bei deiner jetzigen Mappe ist das nicht mehr der Fall. Lasse also die beiden markierten Zeilen weg, dann wird dies nicht mehr überprüft und generell alle Zeilen durchlaufen.


    Tabellen zusamenkürzen GrußformelTabellen zusamenkürzen Beverly's Excel - Inn
     
    Beverly, 20. Januar 2021
    #23
    1 Person gefällt das.
  9. suey
    suey User
    es .... geht .....
    Tausend Dank !
     
Thema:

Tabellen zusamenkürzen

Die Seite wird geladen...
  1. Tabellen zusamenkürzen - Similar Threads - Tabellen zusamenkürzen

  2. Excel Tabellen Vergleich

    in Microsoft Excel Hilfe
    Excel Tabellen Vergleich: Hallo liebe Community Ich habe spalte A mit Namen Befüllt in Tabell 2 Spalte A stehen diese Namen auch aber durchgewürfelt mit einem dazugehörigem Wert in Spalte B Ich möchte nun in einer Spalte...
  3. Feiertag aus Tabelle - ganze Zeile markieren

    in Microsoft Excel Hilfe
    Feiertag aus Tabelle - ganze Zeile markieren: Hallo, ich habe ein weiteres Problem mit meiner Tabelle. Auf dem Blatt "Kursplanung" steht in Spalte C alle drei Zeilen ein fortlaufendes Datum. Auf einem anderen Blatt "Daten" gibt es eine...
  4. Zugriffsrechte für eine bestimmte Tabelle

    in Microsoft Access Hilfe
    Zugriffsrechte für eine bestimmte Tabelle: Hallo Ich würde gerne meine Datenbank so programmieren, sodass einer die Datenbank nur ausführen kann und nichts verändern kann, jedoch aber in einer bestimmten Spalte, bzw Tabellenfeld die...
  5. Pivot Tabelle sortiert Monate bei Jahreswechsel nicht richtig

    in Microsoft Excel Hilfe
    Pivot Tabelle sortiert Monate bei Jahreswechsel nicht richtig: Guten Abend! ich habe ein kleines Problem mit einer Pivot-Tabelle und hoffe, dass mir hier jemand helfen kann. In den Quelldaten für die Tabelle hat jeder Datensatz ein fortlaufendes Datum. In...
  6. vorhandene Tabelle sortieren

    in Microsoft Excel Hilfe
    vorhandene Tabelle sortieren: Hallo und guten Tag, ich habe ein Problem und finde meinen Denkfehler nicht :( Ich habe eine Adress-Liste mit Geburtsdaten, diese möchte ich gerne so sortiert haben, das dass erste...
  7. sVerweis Blattübergreifend verwenden

    in Microsoft Excel Hilfe
    sVerweis Blattübergreifend verwenden: Hallo Leute, ich habe eine Formel die wie folgt ausschaut: =SVERWEIS(Hersteller_Aus&Modell_Aus;WAHL({1.2};AMX!B2:B500&AMX!C2:C500;AMX!D2:D500);2;0) D.h.: Er sucht den Wert, welcher in der Zelle...
  8. Gekennzeichnete Spalten mit WENN-Bedingung in Makro nach 5 Tabellen kopieren

    in Microsoft Excel Hilfe
    Gekennzeichnete Spalten mit WENN-Bedingung in Makro nach 5 Tabellen kopieren: Hallo, Ich habe ein Makro, welches ich gerne ein wenig erweitern möchte, um mir bei der Weiterverarbeitung der Ergebnisse deutlich Zeit zu sparen. Da dies meine sehr rudimentären Makrokenntnisse...