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

Tabelle sortieren - dynamische Erweiterung

Tabelle sortieren - dynamische Erweiterung
26.09.2014 14:34:49
Christoph
Hallo,
ich habe eine Datei im hochgeladen: https://www.herber.de/bbs/user/92840.xlsm
Dort kann ich über den Button 'Neues Projekt' eine Zeile hinzufüge. Wenn ich dann Eintragungen mache bei:
'Objekt'
'PLZ'
'Maßnahme'
und 'Starttermin',
werden Daten automatisch berechnet und die Grafik erweitert.
Wenn ein neues Projekt hinzukommt, möchte ich die Liste über einen weiteren Button sortieren - 'Sortieren nach Starttermin'. Ich habe ein Makro mit dem Button verknüpft. Diese Lösung hat aber zwei Probleme:
1.) Sie ist nicht dynamisch. Ggw. habe ich den Bereich bis Zeile 71 definiert. Wenn ich dann ein zweites Projekt hinzufüge, funktioniert die Sortierung nicht mehr. Ich brauche also eine Lösung die den Bereich dynamisch erweitert. Ich habe damit angefangen, komme aber zu keiner einwandfrei funktionierenden Lösung.
2.) Wenn ich die Liste mit der bisherigen Lösung sortiere, nachdem ich ein Projekt hinzugefügt habe, sortiert er dieses immer an den Anfang der Liste, auch wenn es obgleich seines Datums in der Mitte stehen müsste.
Ich wäre sehr sehr dankbar wenn mir geholfen werden kann. Ich werde es bis dahin weiter versuche. Der Ehrgeiz ist geweckt. Allerdings wird es mit der Zeit etwas frustrierend.
Vielen vielen Dank im Voraus. Einen schönen Tag Euch.
VG, Christoph

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabelle sortieren - dynamische Erweiterung
26.09.2014 15:03:30
yummi
Hallo Christoph
mal als Ansatz:

Dim wkb As Workbook
Dim wks As Worksheet
Dim strRange As String
Dim rng As Range
Set wkb = ThisWorkbook
Set wks = wkb.Sheets(1)
strRange = "C:C"
Set rng = wks.Range(strRange).Find(What:="", After:=wks.Cells(4, 3))
MsgBox (rng.Row)
End Function
Sub test()
myfind
End Sub
liefert dir die erste Leerzeile nach deienr Tabelle. Das kannst Du benutzen um dien hardcoded Bereich dynamisch zusammen zu bauen
Die zeile .SetRange Range("B4:AU71")
lautet dann in 2 zeilen

dim rng as range
Set rng = ActiveSheet.Range("C:C").Find(What:="", After:=ActiveSheet.Cells(4, 3))
.SetRange Range("B4:AU" & rng.Row)

Gruß
yummi

Anzeige
AW: Tabelle sortieren - dynamische Erweiterung
26.09.2014 15:44:11
Christoph
Hallo Yummi,
vielen Dank für deine Antwort. Ich werde deine Lösung gleich sofort umsetzen.
Ich habe in der Zwischenzeit einen anderen Ansatz versucht.
Sub Sortieren()
Dim lngLastRow As Long
With ThisWorkbook.Worksheets("Tabelle1")
lngLastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range(.Cells(5, 9), .Cells(lngLastRow, 9)), _
SortOn:=xlSortOnValues, Order:=xlAscending
.Sort.SetRange .Range(.Cells(5, 2), .Cells(lngLastRow, 36))
.Sort.Header = xlYes
.Sort.MatchCase = False
.Sort.Orientation = xlTopToBottom
.Sort.SortMethod = xlPinYin
.Sort.Apply
End With
End Sub
Es funktioniert SEMIGUT... Die ersten 3 neuen Einträge sortiert er mir unabhängig vom Datum immer an den Anfang der Tabelle - sortiert diese drei Einträge aber dann untereinander nach dem Datum. Ab dem 4. neuen Eintrag sortiert er die Einträge 2-4 (bzw. auch alle weiteren) richtig in die Tabelle ein, lässt aber den ersten Eintrag weiter am Anfang der Tabelle stehen.
Was mache ich jetzt falsch? Dynamisch ist das Ding mittlerweile wenigstens. Nur funktioniert es halt nicht hundert Prozent.
Danke Danke

Anzeige
AW: Tabelle sortieren - dynamische Erweiterung
26.09.2014 17:54:56
yummi
Hallo Christoph,
dein range für das Sortieren ist falsch.
.Range(.Cells(29, 9), .Cells(lngLastRow, 6)) sortiert dir ab I29 bis F[letzteZeile)
Du willst aber, denke ich, "C4:Y70" sortieren. C4:Y ist vorgegeben, wenn du deine Tabelle nicht nach oben oder rechts erweitern willst. Wie du auf die 70 kommst habe ich dir im letzten post geschrieben.
Gruß
yummi

AW: Tabelle sortieren - dynamische Erweiterung
26.09.2014 19:14:24
Christoph
Hallo,
danke nochmals yummi. Ich trete leider weiter auf der Stelle. Denke aber ich bin auf dem richtigen Weg. Hier mein aktueller Stand mit dem aktuellsten Makro.
https://www.herber.de/bbs/user/92846.xlsm
Die Tabelle ist ab Zeile 70 um 1-10 Zeilen über den entsprechenden Button zu erweitern. Die neuen Einträge möchte ich dann über den 'sortieren' Button in meine Liste entsprechend des Datums einsortieren (die Liste muss von B5:AT dynamisch sortiert werden). Der Button funktioniert schonmal teilweise dynamisch. Leider gibt es noch das Problem, dass das Makro die ersten drei neuen Einträge (Zeile 71-73) immer unabhängig vom Datum an den Anfang der Liste sortiert. Ab dem 4. (Zeile 74) etc. funktioniert die Sortierfunktion. Was also mache ich falsch, dass das Makro Probleme mit den ersten drei neuen Einträgen hat?
Vielen Dank für Deine bzw. Eure Hilfe. VG, Christoph

Anzeige
AW: Tabelle sortieren - dynamische Erweiterung
26.09.2014 20:28:42
yummi
Hallo Christoph,
das müsste das liefern, was du willst:
Sub Sortieren()
Dim lngLastRow As Long
With ThisWorkbook.Worksheets("Tabelle1")
lngLastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("I5:I" & lngLastRow), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SetRange .Range("B4:Y" & lngLastRow)
.Sort.Header = xlYes
.Sort.MatchCase = False
.Sort.Orientation = xlTopToBottom
.Sort.SortMethod = xlPinYin
.Sort.Apply
End With
End Sub
Gruß
yummi

Anzeige
AW: Tabelle sortieren - dynamische Erweiterung
27.09.2014 01:57:58
Adis
Hallo
Sorry, mein Fehler, beim Thread Zeile einfügen mit Cancel. siehe (Exit Sub)
Wegen dem Server musste ich Exit in Klammer setzen, bitte ohne () einfügen
a = InputBox("Bitte Anzahl neue Zeilen eingeben (max. 10)")
If a = Empty Then (Exit Sub) 'Ende bei Cancel
Hier die dynamische Erweiterung für die Sortier Routine, über z = Zeile
Geprüft wird die Endzeile in 2 Spalten, zur Sicherheit. Objekt + PLZ
Prüfen kann man die Adressierung über Range("B4:AU" & z).Select: (Exit Sub)
Gibt es eine Unstimmigkeit wird die höhere Zeilenzahl ausgewertet.
Sub ProjekteSortierenDatum_Neu()
'in Spalte Objekt + PLZ End Zeile finden
o = Range("C5").End(xlDown).Row
z = Range("D5").End(xlDown).Row
If o  z Then
If o > z Then z = o  'Warn Hinweis bei ungleichmaessigen Spalten
MsgBox "Spalte C + D nicht korrekt ausgefüll - Sortiert wird bis Zeile  " & z
End If
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("I:I"), SortOn:=xlSortOnValues, Order:=xlAscending
.SetRange Range("B4:AU" & z)   'Range dynamisch über z = Zeile
.Header = xlYes
.Apply
End With
End Sub
Gruss Adis

Anzeige
AW: Laufzeitfehler vorbeugend abfangen
27.09.2014 13:35:30
Adis
Hallo
ich habe die Mappe noch mal getestet und zwei Fehler abgefangen die in der Praxis
auftreten könnten. Versehentliche Eingabe von Buchstabe statt Zahl in die InpuBox
und neue Zeile einfügen, wenn noch eine leere vorhanden ist. In diesem Fall würde
die SpecialCell.ClearContents Anweisung in einen Laufzeitfheler laufen. Deshalb
die On Error Resume Next Anweisung -vor SpecialCells-. Erfahrungen der Praxis....
Die InputBox habe ich geaendert, jetzt zeigt sie beim Start immer den Wert 1 an.
Einfacher zum abklicken mit OK, wenn man nur um 1 Zeile erweitern will.
Sub NeuesProjekt()
Dim Zeile As Long
With ActiveSheet
a = InputBox("Bitte Anzahl neue Zeilen eingeben  (max. 10)", , 1)
If a = Empty Then Exit 

Sub       'Abbruch bei Cancel
If Not IsNumeric(a) Then a = 1   'bei Buchstabe a=1
If a  10 Then a = 10
Zeile = .Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
Range(.Rows(Zeile - a), .Rows(Zeile - 1)).Copy
.Cells(Zeile, 1).Insert xlDown
Application.CutCopyMode = False
On Error Resume Next   'Schutz vor Laufzeit Fehler bei Leerzeile
Zeile = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
Range(.Rows(Zeile - a + 1), .Rows(Zeile)).SpecialCells(xlCellTypeConstants).ClearContents
End With
End Sub
Gruss Adis

Anzeige
AW: Laufzeitfehler vorbeugend abfangen
01.10.2014 07:32:05
Hajo_Zi
warum offen lass dies doch den Fragesteller entscheiden. Es ist Heute nicht üblich eine Rückmeldung zu geben und so ist der Beitrag 6 Tage offen.

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige