Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema RefEdit
BildScreenshot zu RefEdit RefEdit-Seite mit Beispielarbeitsmappe aufrufen

Bereich sortieren (nochmal)

Betrifft: Bereich sortieren (nochmal) von: Michl
Geschrieben am: 16.08.2004 15:39:55

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
  


Betrifft: AW: Bereich sortieren (nochmal) von: PeterW
Geschrieben am: 16.08.2004 15:51:58

Hallo Michl,

dann sollte das so gehen:
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

Gruß
Peter


  


Betrifft: AW: Bereich sortieren (nochmal) von: PeterW
Geschrieben am: 16.08.2004 16:01:18

Hallo Michl,

sorry, hab eine Bedingung nicht beachtet. So funktionierts auf jeden Fall:
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

Gruß
Peter


  


Betrifft: AW: Bereich sortieren (nochmal) von: Michl
Geschrieben am: 16.08.2004 16:41:19

Hallo Peter,

ich hab grad meine ursprüngliche Antwort verfasst, in der ich dir ein weiteres Problem beschreiben wollte.
Nun hat sich des erledigt, weil du mir zuvor gekommen bist ;)

Hab deine zuletzt gepostete Lösung grad ausprobiert... es lübbt jetzt wieder mal einwandfrei.
Was tät ich bloß ohne dich :D

Also nochmal ein riesen fettes Dankeschön an dich.


Michl


  


Betrifft: AW: Bereich sortieren (nochmal) von: Michl
Geschrieben am: 16.08.2004 16:58:39

Ich bins nochmal.

Wart bitte nochmal, bevor du es ins Archiv schiebst. Ich glaub da gibts noch ein Problem, muss mal schaun. Kann ich heut nimma prüfen, aber bitte lass das Thema noch offen.

Danke,
Michl


  


Betrifft: AW: Bereich sortieren (nochmal) von: PeterW
Geschrieben am: 16.08.2004 17:06:52

Hallo Michl,

hier wird nichts händisch ins Archiv verschoben, das geschieht automatisch nach einigen Tagen. :-)

Gruß
Peter


  


Betrifft: AW: Bereich sortieren (nochmal) von: Michl
Geschrieben am: 17.08.2004 09:18:20

Hallo Peter,

aso... is ja eigentlich auch logisch. *g*
Früher war das noch ganzzzz anders... ;)

Also nu zu meinem noch bestehenden Problem:

Dein Code funktioniert leider noch nicht ganz einwandfrei bzw. es könnte auch sein, dass ich einen Code-Fehler drinne hab.
Schau dir doch bitte mal folgendes Excel-Sheet an:
-- https://www.herber.de/bbs/user/9733.xls --

Sobald man einen Namen eingibt, der sich alphabethisch gesehen "über" den anderen Namen in Spalte A befindet, funktioniert alles einwandfrei.

Gibt man aber allerdings einen Namen, der sich alphabetisch gesehen "unter" den anderen Begriffen befindet ein, so macht das Makro einen Fehler und überschreibt immer die Zellen "B3", "B4" und "B5".

Schau dir die .xls einfach mal und gib z.B. den Namen "Rudi" ein, dann siehst du was ich mein.

Hoffe du kannst mir auch hier helfen. :)
(P.S.: Nehme mal an, wenn mal die Zellinhalte schreiben lässt, dann muss auch hier eine if-Abfrage stattfinden, oder?)

Gruß,
Michl


  


Betrifft: AW: Bereich sortieren (nochmal) von: PeterW
Geschrieben am: 17.08.2004 12:27:35

Hallo Michl,

wenn du immer mal wieder mit neuen Wünschen um die Ecke kommst kann das auch nicht mehr funktionieren. ;-)
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

Der Fehler entsteht, weil die Schaltfläche den Fokus hält. Wechsele in der Tabelle in den Entwicklungsmodus, rechte Maustaste auf die Schaltfläche, Eigenschaft, TakeFocusOnClick auf False.

Gruß
Peter


  


Betrifft: AW: Bereich sortieren (nochmal) von: Michl
Geschrieben am: 17.08.2004 13:19:51

Hallo Peter,

hehe...ich mach das doch immer mit Absicht, will dich immer a bissl ärgern. ;P

Kann ja au nix für, mein Cheffe will ständig was anderes. (Hammer raushol) *g*

Jetzt muss ich dir aber wieder mal ein riesen fettes Dankeschön zusenden, da wieder mal alles so lübbt, wie ich mir das vorgestellt hab. *Standing Ovations* :)

Nu muss ich dich aber trotzdem nochmal löchern. Leider kann ich jetzt nicht ganz nachvollziehen, was für ein Fehler du meinst. Wenn ich TakFocusOnKlick auf True lasse, dann funzt der Code immer noch einwandfrei. Deswegen frag ich ja auch so dumm... :/

Und eine letzte (vorläufig *g*) Bitte hab ich noch an dich:
Kannst du mir mal kurz erklären, was in diesem Anweisungsblock passiert:

Private Sub Auszug()
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
End Sub


Ich versteh die Syntax ned ganz.
Wäre echt supi supi nett von dir. Thx... =)


Grüssle,
Michl


  


Betrifft: AW: Bereich sortieren (nochmal) von: PeterW
Geschrieben am: 17.08.2004 14:54:04

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 > 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


  


Betrifft: AW: Bereich sortieren (nochmal) von: Michl
Geschrieben am: 17.08.2004 15:25:08

Boah...also wenn du kein Guru bist, dann bin ich der Weihnachtsmann. ;D

Thx, dass du den Code erklärt hast, ich muss des aber noch a paar Mal durchlesen, um alles 100%ig intus zu haben. *g*

Gruß,
Michl


 

Beiträge aus den Excel-Beispielen zum Thema "Bereich sortieren (nochmal)"