Registriert seit: 09.05.2015
Version(en): 2013, Office 365
Hallo und schönen guten Abend,
vielleicht kann mir jemand bei meinem Problem helfen.
In der Spalte "A" steht am unteren Ende in der Datenreihe der Begriff "stopp". Nachfolgend stehen aber noch weitere Daten und davor natürlich auch.
Vor der dem Begriff "stopp" sind aber eine undefinierte Anzahl von Leerzeilen bis zur nächsten nicht leeren Zelle.
Genau diese Zelle möchte ich per VBA finden um ab dort weitere Datensätze einzufügen - also rückwärts ab dem Begriff den letzten Datensatz suchen.
Über einen Tipp würde ich mich freuen.
Vielen Dank!
Erich
Registriert seit: 30.01.2015
Version(en): 2013
Hi
funktioniert das hier?
Code: Sub tst()
MsgBox "Eine freie Zelle befindet sich in " & Range("A1").End(xlDown).Offset(1).Address(0, 0)
End Sub
Grüße,
Winny
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallöchen,
wenn sich da noch min. eine Leerzelle weiter oben versteckt, klappt es nicht . Da könnte dieser Ansatz helfen. Das ist jetzt ohne Abfangen der Möglichkeit, dass in der Spalte der Begriff "Stop" fehlt. Das LookAt:=xlVaues wäre auch suboptimal, wenn in den Zellen Formeln stehen, die "" zurückgeben. Ich nehme jetzt aber an, dass beides nicht der Fall ist.
Code: Sub test()
MsgBox "Eine freie Zelle befindet sich in " & Columns(1).Find(what:="stop", after:=[A1], LookIn:=xlValues, lookat:=xlWhole).End(xlUp).Offset(1).Address(0, 0)
End Sub
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo Erich,
vielleicht auch so?
Code: Sub Makro1()
Dim rngE As Range
Set rngE = Range("A:A").Find(What:="stopp", LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=False, SearchFormat:=False)
If Not rngE Is Nothing Then
With Range(rngE, rngE.End(xlUp))
If Application.CountBlank(.Cells) Then
.SpecialCells(xlCellTypeBlanks).Cells(1).Value = Now
Else
MsgBox "Nichts mehr frei!"
End If
End With
Else
MsgBox "Kein ""stopp"" in Sicht!"
End If
End Sub
Gruß Uwe
Registriert seit: 09.05.2015
Version(en): 2013, Office 365
Schönen guten Morgen,
vielen Dank an Euch alle.
Eure Vorschläge funktionieren perfekt, genau das habe ich gesucht.
Auch das finden der ersten freien Zelle kann ich gut verwenden.
Danke und noch einen schönen Sonntag
Gruss Erich
Registriert seit: 09.05.2015
Version(en): 2013, Office 365
Hallo zusammen,
nach Eurer Hilfe stellt sich mir nun noch ein weiteres Problem.
Wie kann ich nun noch eine Datenreihe, die unterschiedlich lang sein kann, zwischen dem letzten Datensatz, das ist die letzte beschriebene Zelle vor dem Begriff "stopp" einfügen?
Dabei kann eine leere Zelle zwischen dem "stopp" sein, aber "stopp" kann auch direkt auf die letzte beschriebene Zelle folgen.
Es sollte also, unabhängig wie lange der einzufügende Datensatz ist und vor der "stopp"-Stelle, neue Zeilen und die Daten eingefügt werden.
Vielleicht habt Ihr mir dazu noch Tipps?
Vielen Dank!
Gruß Erich
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallo Erich,
hier mal mein Ansatz:
Code: Sub VorStopper()
'Variablendeklarationen
Dim rngStop As Range
'"stop" finden und Zelle zuweisen
Set rngStop = Columns(1).Find(What:="stop", After:=Range("A1"), LookIn:=xlValues, LookAt:=xlWhole)
'wenn von der stop-Zelle und bis zur mit End(xlUp) gefundenen Zelle 2 Eintraege sind, dann
If WorksheetFunction.CountA(Range(rngStop, rngStop.End(xlUp))) = 2 Then
'unter der mit End(xlUp) gefundenen Zelle eine Zeile einfuegen
rngStop.End(xlUp).Offset(1, 0).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'oder wenn es mehr Eintraege sind, ist keine Leerzeile dazwischen und dann
Else
'ueber "stop" eine Zeile einfuegen
rngStop.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'Ende wenn von der stop-Zelle und bis zur mit End(xlUp) gefundenen Zelle 2 Eintraege sind, dann
End If
End Sub
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 09.05.2015
Version(en): 2013, Office 365
Hallo an alle,
dank Euren Rückmeldungen habe ich mal versucht weiterzukommen.
Ziel war es einen zu kopierenden Bereich aus Tabelle2 zu ermitteln und diesen Bereich in Tabelle1 nach der letzten beschriebenen Zeile und vor einer "stopp"-Marke einzufügen.
Das Makro funktioniert soweit weist aber einige Merkwürdigkeiten auf. Vielleicht könnt Ihr mir erklären was die Ursachen sein könnten? Vielleicht ist es banal aber ich checke es nicht.
1. Nach Ablauf des Makros muss ich immer erst wieder in eine Zelle klicken damit sich das erwünsche Ergebnis aufbaut/zeigt.
2. Das Makro kopiert zu Beginn einen Quellbereich und obwohl ich nirgends eine Anweisung zum Einfügen in den Zielbereich gebe (siehe beigefügten Code wo die Stelle auskommentiert ist), wird der Quellbereich umkopiert. Das verstehe ich nicht! Hat das etwas mit der Zwischenablage zu tun?
3. Könnte man das Makro noch optimieren? Da kann ich sicher von Euch noch lernen.
So hier mein Versuch:
Code: Sub x_zeilen_einfuegen()
Dim varAnzahl As Variant
'zu kopierenden Bereich ermitteln
lastLine = Sheets("Tabelle2").Cells(Rows.Count, 2).End(xlUp).Row
'Quellbereich kopieren
Sheets("Tabelle2").Range("B1:B" & lastLine).Copy
'Range("B1").End(xlDown).Copy
'Erste freie Zelle in Zielbereich suchen
ersteFreieZeile = Range("A1").End(xlDown).Offset(1).Row
'Stopp-Marke suchen
With ActiveSheet
For lngI = .Range("A65536").End(xlUp).Row To 1 Step -1
If .Cells(lngI, 1).Value = "stopp" Then ' Schluesselwort: stopp
stoppzeile = .Cells(lngI, 1).Row
End If
Next lngI
End With
Rows(stoppzeile).Select
'Freie Zeilen zwischen ersten freien Zeile und "stopp"-Marke ermitteln und fehlende Zeilen einfügen
varAnzahl = stoppzeile - ersteFreieZeile
If varAnzahl > 0 Then
varAnzahl = lastLine - varAnzahl
Else
ersteFreieZeile = ersteFreieZeile - varAnzahl * -1
varAnzahl = lastLine
End If
If stoppzeile > ersteFreieZeile Then
'Unterhalb erster Leerzeile weitere Zeilen einfügen:
If varAnzahl <> False Then Rows(ersteFreieZeile & ":" & ersteFreieZeile + CDbl(varAnzahl)).Insert Shift:=xlDown
Else
'Oberhalb der "stopp"-Zeile weitere Zeilen einfügen:
Rows(ersteFreieZeile & ":" & ersteFreieZeile + CDbl(varAnzahl)).Insert Shift:=xlDown
End If
'Kopierten Quellbereich jetzt einfügen
'ActiveSheet.Range(Cells(ersteFreieZeile, 1), Cells(ersteFreieZeile, 1)).PasteSpecial Paste:=xlValues
'Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Vielen Dank für Eure Rückmeldung
Gruß Erich
Mit freundlichen Grüßen / Best regards
//
----------o00o---°(_)°---o00o----------------------
Erich
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallo Erich,
1. sollte eigentlich ohne Klicken funktionieren. Diese Zeile
Application.ScreenUpdating = True
brauchst Du nur, wenn Du sie vorher mal mit False programmiert hast, hab ich aber nicht gesehn ...
2. Insert ist auch einfügen. Kannst mal Kopieren und einfügen aufzeichnen, beim Einfügen "Kopierte Zellen einfügen" nehmen.
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 09.05.2015
Version(en): 2013, Office 365
(14.05.2015, 18:01)schauan schrieb: Hallo Erich,
1. sollte eigentlich ohne Klicken funktionieren. Diese Zeile
Application.ScreenUpdating = True
brauchst Du nur, wenn Du sie vorher mal mit False programmiert hast, hab ich aber nicht gesehn ...
2. Insert ist auch einfügen. Kannst mal Kopieren und einfügen aufzeichnen, beim Einfügen "Kopierte Zellen einfügen" nehmen.
Hallo,
danke für die Rückmeldung.
Ist mir klar dass diese Zeile hier überflüssig ist, tut aber erstmal auch nicht weh.
Application.ScreenUpdating = True
Ich habe mal eine Aufzeichnung durchgeführt:
aber ich kann hier nichts erkennen was den Unterschied, außer dem .Select ausmachen könnte.
Hättest du noch eine Idee?
Code: Sub Makro1()
'
Sheets("Tabelle2").Select
Range("B1:B20").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("C1").Select
Selection.Insert Shift:=xlDown
End Sub
Vielen Dank!
Mit freundlichen Grüßen / Best regards
//
----------o00o---°(_)°---o00o----------------------
Erich
|