Bei Fehler verzweigen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Erich und Matthias,
super, vielen Dank. Tatsächlich könnte (theoretisch, aber sehr unwahrscheinlich) die Zelle mit # beginnen, insofern ist Erichs Vorschlag schon besser.
Gut, zur Art und Weise wie ich programmiere: Da ich kein Informatiker bin, lege ich das Augenmerk nicht auf die Einhaltung gewisser progrmmierrichtlinien. Diese sind sicherlich sinnvoll bei sehr komplexen Programmen, vor Allem wenn man viel später einmal modifizieren muß oder will.
Nun, ich weiß nicht, wie viel Zeit und Lust ihr habt? Ich möchte hier jetzt nichts fordern, ich stelle euch aber trotzdem mal meinen kompletten (für Informatiker sicher stümperhaften) Quellcode rein. Das ist aber auch noch nicht fertig, da steht dann aber "under construction".
Was soll dieser Makro?
Ich klicke in eine beliebige Zelle. Diese soll vom Makro nach unten kopiert werden, und zwar benötige ich das oft über große Bereiche: Genau so weit, wie links davon (Sonderfall wenn ich in Spalte A bin: wie rechts davon) etwas befüllt ist. Zuvor wird noch geprüft, ob von der betreffenden Zelle nach unten hin auch alles leer ist, um ungewolltes Überschreiben zu verhindern. (Verbesserungspotezial: Nur die die tatsächlich durch den Makro befüllt werden sollen, auf Leerheit prüfen. Allerdings steht selten drunter noch etwas.)
Als Bonus noch die Verzweigung, daß ich z. B. "uw" eingebe, dann soll eine Formel für unterschiedliche Werte ausgefüllt werden. Hierbei kann mir natürlich immer etwas neues einfallen, das kann ich ja dann immer dazubauen.
Sodele, aber wie gesagt, erwarten tue ich nicht von euch, daß ihr das anguckt, den es läuft ja auch so lala, aber freuen würde mich es schon.
Liebe Grüße und nochmals Danke für den wertvollen Tipp, Claus.


Sub copylinks()
' copy der aktuellen Zelle nach unten, bis zur höchsten befüllten Zeilennr. weiter links
Dim bs As Variant
Dim bz As Variant
Dim prf As Variant
Dim af As Variant
bs = ActiveCell.Column
bz = ActiveCell.Row
' sicherstellen, dass zu befüllender Bereich leer
Selection.End(xlDown).Select
If ActiveCell.Row  "" Then Stop
' letzte Zeile der nächstbefüllten Spalte links (bzw. rechts, wenn´um Spalte A geht) daneben  _
feststellen
prf = 0
10
prf = prf + 1
If bs = 1 Then prf = prf - 2
Cells(65536, bs - prf).End(xlUp).Select
af = ActiveCell.Row
If af  bs Then Stop
' kann sein, wenn A1 verbundene Zelle
' Verzweigung wenn "uw" oder "uwf"
Stop
' Bei Fehler geht die Abfrage nicht, deshalb vorab bei Fehler goto 30
' If Left(Selection.Text, 1) = "#" Then GoTo 30
If IsError(Selection(1)) Then GoTo 30
'if Selection = "fehlermeldung, wie auch immer das hinzubekommen ist) then goto 30
If Selection = "uw" Then GoTo 700
If Selection = "uwf" Then GoTo 750
30
Selection.Copy
ActiveCell.Offset(0, 0).Range(af).Select
ActiveSheet.Paste
'zum Ende springen bzw. Anfang, wenn rechts noch was kommt
Selection.End(xlToRight).Select
If ActiveCell.Column  1 Then Stop
ActiveCell.Offset(1, 0).Range("A1").Select
'ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(MATCH(RC[-1],R1C[-1]:R[-1]C,0)),RC[-1],"""")"
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(MATCH(RC[-1],R1C[-1]:R[-1]C[-1],0)),RC[-1],"""")"
Selection.Copy
ActiveCell.Offset(0, 0).Range(af).Select
ActiveSheet.Paste
Stop
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.End(xlDown).Select
Selection.ClearContents
Range("A1").Select
ActiveCell.Offset(bz - 1, bs - 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=RC[-1]"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(MATCH(RC[-1],R[-5]C:R[-1]C,0)),RC[-1],"""")"
GoTo 990
750
' Warnung falls Vorzeile nicht sortiert, Formel für unterschiedliche Werte einkopieren
Stop
' under construction, copyteil:
Selection.Copy
ActiveCell.Offset(0, 0).Range(af).Select
ActiveSheet.Paste
960
Range("A1").Select
ActiveCell.Offset(bz - 1, bs - 0).Range("A1").Select
GoTo 990
980
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
990
End Sub

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread