|
Hi Thomas,
die Hammermethode :
Sub WertVorErsteSpalteEinfügen()
FügeEin 12.2 '12.2 = konstanter Wert(Dezimalpunkt!) oder "abc" als Zeichenfolge
End Sub
Private Function FügeEin(Wert)
Columns(1).Insert Shift:=xlToRight 'neue Spalte
Cells(1, 1).Value = Wert 'eintragen
Range(Cells(1, 1), _
Cells(Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row, 1)).FillDown
End Function
die Luxusvariante mit frei wählbarer Zahl und Prüfung :
Option Explicit
Private LetzteZeile As Long
Private LetzteSpalte As Long
Private MeineZahl As Double
Sub VorErsteSpalteEinfügen()
On Error GoTo errorhandler
If Blattbereich Is Nothing Then GoTo errorhandler 'leeres Blatt ?!?
If Not EingabeZahl Then GoTo errorhandler 'keine Zahl
Columns(1).Insert Shift:=xlToRight 'neue Spalte
Cells(1, 1).Value = MeineZahl 'eintragen
Range(Cells(1, 1), Cells(LetzteZeile, 1)).FillDown 'nach unten
Exit Sub
errorhandler:
MsgBox "Fehler in den Vorgaben"
End Sub
Private Function Blattbereich() As Range
Rem leere Zwischenräume im gesamten Blatt berücksichtigen
On Error GoTo errorhandler
LetzteZeile = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
LetzteSpalte = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
Set Blattbereich = Range(Cells(1, 1), Cells(LetzteZeile, LetzteSpalte))
Exit Function
errorhandler:
End Function
Private Function EingabeZahl() As Boolean
Rem Zahl(String) abfragen und konvertieren
On Error GoTo errorhandler
MeineZahl = CDbl(InputBox("Zahl = : ", "Abfrage"))
EingabeZahl = True
Exit Function
errorhandler:
End Function
Viel Spaß H27
|