Bereich sortieren (nochmal)

Hallo Zusammen!
Muss mich nun wieder mal melden, weil ich wieder ein Problem habe bzw. ich muss die Lösung abändern.
https://www.herber.de/index.html?https://www.herber.de/forum/archiv/468to472.htm
(Thema: "fdd" von "d")
Wenn ihr euch das mal durchlesen könntet, wäre supi.
Jetzt hat sich aber nun die Anordnungsmatrix geändert und zwar wie folgt:
A1: hans B1: hans.doc C1: 16.07.1999
B2: hans_s.ppt C2: fehlt noch
B3: hans_z.ppt C3: existiert
A4: gerhard B4: gerhard.doc C4: 04.06.2001
B5: gerhard_s.ppt C5: existiert
B6: gerhard_z.ppt C6: fehlt noch
A6: gerhard B6: gerhard.doc C6: 04.06.2001
B7: gerhard_s.ppt C7: existiert
B8: gerhard_z.ppt C8: fehlt noch
Das heißt also, dass der Zeilenabstand zwischen den jeweiligen Inhalten der Spalte A jetzt nicht mehr 2 Zeilen beträgt, sondern variert.
Der Rhythmus bleibt somit nicht mehr erhalten und das Makro kommt ins schleudern.
--> lngRow = lngRow + 3 (passt nicht mehr!)
Wie kann ich den Code abändern, sodass die Funktion des Makros noch voll erhalten bleibt?
Vielen Dank für eure Hilfe schonmal im Voraus.
P.S.: Habs schonmal versucht, aber nicht ganz hingekriegt, er wirft dann an bestimmten Stellen eine Fehlermeldung raus.


Sub Michl()
Dim strText As String
Dim lngRow As Long
strText = InputBox("Name eingeben", "Name?")
lngRow = 1
Do Until Cells(lngRow, 1) > strText
lngRow = lngRow + 1
Loop
Rows(lngRow & ":" & lngRow + 2).Insert
Cells(lngRow, 1) = strText
End Sub

Gruß,
Michl

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Michl() Dim strText As String Dim lngRow As Long strText = InputBox("Name eingeben", "Name?") lngRow = 1 Do Until Cells(lngRow, 1) > strText Or lngRow > Range("A65536").End(xlUp).Row lngRow = lngRow + 1 Loop Rows(lngRow & ":" & lngRow + 2).Insert Cells(lngRow, 1) = strText End Sub

Sub Michl() Dim strText As String Dim lngRow As Long strText = InputBox("Name eingeben", "Name?") lngRow = 1 If strText > Cells(Range("A65536").End(xlUp).Row, 1) Then Cells(Range("A65536").End(xlUp).Row + 3, 1) = strText Else Do Until Cells(lngRow, 1) > strText lngRow = lngRow + 1 Loop Rows(lngRow & ":" & lngRow + 2).Insert Cells(lngRow, 1) = strText End If End Sub

Private Sub CreateButton_Click() Dim strText As String Dim lngRow As Long strText = InputBox("Name eingeben", "Name?") If strText = "" Then Exit Sub lngRow = 3 If strText > Cells(Range("A65536").End(xlUp).Row, 1) Then Cells(Range("A65536").End(xlUp).Row + 3, 1) = strText lngRow = Range("A65536").End(xlUp).Row Else lngRow = 3 Do Until Cells(lngRow, 1) > strText lngRow = lngRow + 1 Loop Rows(lngRow & ":" & lngRow + 2).Insert Cells(lngRow, 1) = strText End If test1 = "test1" Worksheets("Tabelle1").Cells(lngRow, 2).Value = test1 test2 = "test2" Worksheets("Tabelle1").Cells(lngRow + 1, 2).Value = test2 test3 = "test3" Worksheets("Tabelle1").Cells(lngRow + 2, 2).Value = test3 End Sub

Hallo Michl,
für das Einfügen der Zeilen gibt es drei Möglichkeiten: am Anfang (das wird durch die Schleife schnell gefunden), am Ende (das erledigt der erste Teil der If-Bedingung) oder irgendwo mitten in der Liste (dann muss halt mit Do - Loop gesucht werden).
Die letzte gefüllte Zelle der Spalte A wird ermittelt mit
Range("A65536").End(xlUp).Row
damit steht der letzte Wert in Spalte A in
Cells(Range("A65536").End(xlUp).Row, 1)
Jetzt wird verglichen, ob der Wert der Textbox größer ist als dieser Zellwert
If strText &gt Cells(Range("A65536").End(xlUp).Row, 1) Then
Da in Spalte B noch in zwei weiteren Zeilen etwas steht gehört der Wert der Textbox drei Zeilen unter den letzten gefundenen in Spalte A
Cells(Range("A65536").End(xlUp).Row + 3, 1) = strText
Der Else-Teil der Bedingung wird jetzt nicht durchlaufen und damit lngRow nicht hochgezählt. Um die Testtexte in die richtigen Zeilen zu bringen wird also wieder die Zeile des letzten Wertes in Spalte A ermittelt, wo jetzt der soeben dahin geschriebene Inhalt der Textbox steht, und dieser Wert in die Variable lngRow gepackt.
Die Zeile
lngRow = 3
nach
If strText = "" Then Exit Sub
kannst du getrost streichen.
Der Fehler mit TakeFocusOnClick taucht regelmäßig unter Excel8 auf, diese Version hatte ich heute Vormittag zur Verfügung.
Ich hoffe, die Erklärung ist kurz genug ausgefallen. ;-)
Gruß
Peter

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bereich sortieren (nochmal)

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread