Supportnet / Forum / Tabellenkalkulation

Hallo an alle Excel - Freaks ! Ich habe eine Preisliste, die auf einer Excel Liste basiert. In der Spalte A1 Steht der Botanische Name (fett gedruckt), darunter (A2) der deutsche Name, darunter (A3) die Qualität. Neben der Qualität ( B3) kommt die Größe, daneben (B4-6) bis zu 3 Preise. Zur Verdeutlichung hier ein Bild : [url]www.hils-koop.de/pliste.jpg[/url] Die Liste ist in verschiedene Kapitel eingeteilt, manche Pflanzen wiederholen sich zB als Strauch und als Heckenpflanze. Gerne würde ich die Liste alphabetisch nach botan. Namen sortieren, da dies im verkauf praktischer wäre als die Kapiteleinteilung, die für Privatkunden gedacht ist. Jetzt stehen aber eine unterschiedliche Anzahl von Zeilen untereinader, die zusammen gehören, von 3 bis mehr als 7. Das einzig trennende Element ist der Fettdruck. Liesse sich mit Hilfe des Fettdrucks vielleicht doch eine Sortierung vornehmen ? Der Fettdruck zeigt immer den Beginn eines neuen Blocks an, die Blöcke müssten miteinander sortiert werden, der Block selber darf aber nicht auseinander gerissen werden. Ich weiss, dass diese Liste keine Datenbank Struktur hat, aber die Liste wurde aus einer PDF-Datei übernommen, die davor von unserem Brachenprogramm erstellt wurde. Leider ging das nicht anders. Vielleicht klässt sich da was per Makro oder Script machen ? Ich habe davon keine Ahnung, lese aber immer wieder hier im SN voller Ehrfurcht, was mit Excel machbar ist, und wie einfallsreich ihr seid... Auf Rückfragen kann ich leider erst heute spät am Abend oder morgen eingehen, da mein kleiner Sohn jetzt noch meine Aufmerksamkeit fordert... Bis später, Mikoop

Hallo,

grundsätzlich ist die Sortierung nach dem fettgedrucken Text möglich, aber nur mit VBA. Ist es möglich mir die Tabelle zukommenzu lassen?

Schreib mal deine Email-Adresse ich sende dann meine an dich.

Gruß

Helmut

Hallo Mikoop,

folgendes Makro läuft unter folgenden Bedingungen:

- Datenbereich = A1:Exxxx
- es gibt keine Spaltenüberschriften
- nur die botanischen Namen sind in Fettschrift

Option Explicit

Sub sortieren()
    Dim lngI As Long, lngZeile As Long
    Application.ScreenUpdating = False
    For lngI = 1 To ActiveSheet.UsedRange.Rows.Count
        If Cells(lngI, 1).Font.Bold = True Then Cells(lngI, 8).Value = Cells(lngI, 1).Value
        If Cells(lngI, 1).Font.Bold = False Then Cells(lngI, 8).Value = Cells(lngI - 1, 8).Value
    Next
    Columns("A:H").Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("H1"), Order1:=xlAscending, Header:=xlNo
    Columns("H:H").ClearContents
    Application.ScreenUpdating = True
End Sub

Gruß
Rainer

Hi Micop,
du hast recht, ohne weiteres geht das nicht (zumal unterschiedliche Anzahl von Zeilen zu jedem Artikel gehören)
Es ist richtig, dass ein Makro dieses Problem lösen kann (wie so viele)

Ein passendes Makro findest du nachfolgend

Gruß CA

´--------------------------------------------------
Option Explicit

Sub Sortierung()
Dim Anfang, Ende, Ziel As Long ´Zeilen eines zu verschiebenden Blocks
Dim Erste, Letzte As Long ´Zeilen, die mit relevanten Einträgen belegt sind
Letzte = Range("A65536").End(xlUp).Row
Anfang = 1

´Suche Anfang (erste fettgedruckte Zelle in Spalte A)
While Not (Cells(Anfang, 1).Font.Bold Or Anfang > Letzte)
Anfang = Anfang + 1
Wend
Erste = Anfang

´Suche Artikel
While Not Anfang > Letzte

´Suche Ende von Artikel
Ende = Anfang
While Not (Cells(Ende + 1, 1).Font.Bold Or Ende + 1 > Letzte)
Ende = Ende + 1
Wend

´Suche Ziel
Ziel = Erste
While Not (Ziel > Anfang Or (Cells(Ziel, 1).Font.Bold And Cells(Ziel, 1).Value > Cells(Anfang, 1).Value))
Ziel = Ziel + 1
Wend

´Verschieben
If Ziel < Anfang Then
Rows(Trim(CStr(Ziel)) & ":" & Trim(CStr(Ziel + Ende - Anfang))).Select
Selection.Insert Shift:=xlDown
Rows(Trim(CStr(Ende + 1)) & ":" & Trim(CStr(Ende + 1 + Ende - Anfang))).Select
Selection.Copy
Rows(Trim(CStr(Ziel)) & ":" & Trim(CStr(Ziel + Ende - Anfang))).Select
ActiveSheet.Paste
Rows(Trim(CStr(Ende + 1)) & ":" & Trim(CStr(Ende + 1 + Ende - Anfang))).Select
Selection.Delete Shift:=xlUp
End If
Anfang = Ende + 1
Wend
End Sub
´--------------------------------------------------

Hallo,

damit hat sich glaube ich das Problem erledigt, hätte eine entsprechende VBA erst basteln müssen. Da @ rainberg und @ChatAlligator fast gleichen Aufbau ihres Makros haben, werde ich mir nicht mehr die Mühe machen.

Gruß

Helmut

Noch eine kleine Bemerkung zu meinem Makro:

Eine Überschrift würde automatisch berücksichtigt (unabhängig von deren Zeilenanzahl, also nicht mit in Sortierung einbezogen), wenn sie nicht fett geschrieben ist. Anzahl der Zeilen und Spalten eines jeden Artikels spielen keine Rolle.

Einzige Einschränkung:
Es darf keine Tabelle daneben stehen (deren Zeilen würden mitverschoben)

Gruß CA

Hallo,

Danke erst mal an euch alle, ich werde eure Makros übers Wochenende ausprobieren und gebe Bescheid, ob es geklappt hat.

Gruss, Mikoop

Hallo nochmal,

Jetzt habe ich die Makros ausprobiert.
Die Kapitelüberschriften hatte ich vorher von Hand entfernt.

@rainberg
Dein Makro lief sauber durch und hat wie gewünscht sortiert - vielen Dank dafür.

@ChatAlligator
Dein Makro blieb gleich am Anfang mit der Meldung ´Kompilierungsfehler´ stehen. Keine Ahnung was das bedeutet, vielleicht habe ich auch was falsch gemacht, von Makros habe ich keine Ahnung, von Excel auch nicht viel mehr...
Auch dir vielen Dank für die Mühe.

@all
Jetzt hat sich noch ein kleines Problem ergeben (wie das immer so ist...)

Manche Pflanzen (Datenblocks) kommen in mehreren Kapiteln vor. Diese werden jetzt getrennt untereinander geschrieben, obwohl es sich um dieselbe Pflanze in versch. Qualitäten handelt. Zum Teil enthalten diese sogar dieselben Daten.

Wäre es (mit einem 2. Makro) möglich, diese doppelten Datensätze zu eliminieren und die anderen Qualitäten untereinander zu schreiben, statt 2 Blocks mit demselben bot. Namen im Fettdruck untereinander zu legen ?

Grüsse, Mikoop

Hallo Mikoop,

habe das Makro erweitert, die Zeilen mit den mehrfach vorkommenden fetten Namen werden nun gelöscht.

Option Explicit

Sub sortieren()
    Dim lngI As Long
    Application.ScreenUpdating = False
    For lngI = 1 To ActiveSheet.UsedRange.Rows.Count
        If Cells(lngI, 1).Font.Bold = True Then Cells(lngI, 8).Value = Cells(lngI, 1).Value
        If Cells(lngI, 1).Font.Bold = False Then Cells(lngI, 8).Value = Cells(lngI - 1, 8).Value
    Next
    Columns("A:H").Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("H1"), Order1:=xlAscending, Header:=xlNo
    Columns("H:H").ClearContents
    For lngI = 1 To ActiveSheet.UsedRange.Rows.Count
        If WorksheetFunction.CountIf(Range("A$1:A" & lngI), Range("A" & lngI)) > 1 _
        And Range("A" & lngI).Font.Bold = True Then
            Rows(lngI).Delete
            Rows(lngI).Delete
        End If
    Next
    Application.ScreenUpdating = True
    Range("A1").Select
End Sub

Gruß
Rainer

Hallo Rainer,

Nochmals vielen Dank.
Es funktioniert zwar nicht 100 %, aber die paar Reste kann ich in wenigen Minuten von Hand nachbearbeiten.

Viele Grüsse, Mikoop

Hallo Mikoop,

offenbar hat dann deine Beschreibung nicht 100%ig der tatsächlichen Tabellenstuktur entsprochen.

Ich hatte eine Dummy-Tabelle mit 2000 Zeilen gebastelt, wobei es bei jeder Pflanzenart einen fetten botanischen Namen, einen Namen in Normalschrift und 3 bis 6 Zusatzzeilen je Art gibt.

Diese Tabelle hat das Makro 100% richtig sortiert und Mehrfachnamen entfernt.

Gruß
Rainer

Hallo, Rainer,

Aufgeben kennst du nicht ,oder ?

Gesten abend sass ich am Laptop und hatte kein Programm ( und die Daten) zum Upload zur Verfügung.

Jetzt bin ich wieder im Büro und habe ein Bild hochgeladen, wie die Liste nach Durchführung deines 1. Makros aussieht (der gelbe Hintergrund kommt nachträglich von mir und dient nur zur Verdeutlichung)

http://www.hils-koop.de/dublette.jpg

Jetzt hat es 2 x Carpinus betulus (und andere im Laufe der Liste), 1 x könnte der bot. und dt. Name entfernt werden und die Qualitäten untereinander stehen, evtl. doppelt vorh. Sätze gelöscht werden).

Aber das ist nicht all zu viel Mühe wert, da ich das auch von Hand nachbearbeiten kann.

Gruss und schönen Sonntag !

Mikoop

Hallo Mikoop,

ich hatte dich schon richtig verstanden.

Nur noch zur Klarstellung:
Mit der Erstellung des zweiten Makros, hat sich das erste erledigt.
D.h. du kannst das zweite Makro gleich auf die Ursprungsdatei los lassen.

Im Falle deines Bildes löscht das Makro die Zeilen 187 und 188 und das sollte bei dir auch so sein.

Ebenfalls einen schönen Restsonntag und

Gruß
Rainer

• Excel Sortierung nach den letzten Stellen
• Sortierung nach Dateitypen
• Sortierung trotz geschützter Zellen
• Sortierung - Formelveränderung
• Bei gesetztem Excel Autofilter Probleme mit geänderten Feldern bei Sortierung