AW: kleine Ergänzung
24.04.2019 23:02:43
Dieter
Hallo Kisska,
wenn du das Programm aus der PERSONAL.XLSB startest, dann musst du das Wort "ThisWorkbook" durch "ActiveWorkbook" ersetzen. ThisWorkbook ist immer diejenige Arbeitsmappe, in der das Programm steht und das wäre in deinem Fall PERSONAL.XLSB.
Du kannst die Eingabe komplett auf Ziffern beschränken, das geht aber mit der InputBox nicht so elegant, wie mit der UserForm aus deinem Internetbeispiel.
Bei Beschränkung auf Ziffern können 2 Prüfungen entfallen (da die InputBox nur 254 Eingabestellen erlaubt, kann man mit Ziffern nicht das Maximum einer Double-Variablen 1,797E308 überschreiten).
Wenn du davon ausgehen kannst, dass kein Scherzbold z.B. die Zahl 3.000.000 eingibt, dann kannst du auf die Prüfung mit der Gesamtzeilenzahl verzichten, falls deine Arbeitsmappe nicht weit bis unten gefüllt ist. Aber die Prüfung tut doch nicht weh. Bei der InputBox ist der langsame Teil der eingebende Mensch.
Das geänderte Programm sieht jetzt so aus:
Sub Anpassen_II()
Dim dblOft As Double
Dim letzteZeile As Long
Dim lngOft As Long
Dim strOft As String
Const titel As String = "Eingabe der leeren Zeilen"
Dim Wo As Long
Dim ws As Worksheet
Wo = 5
strOft = "2"
Set ws = ActiveWorkbook.Worksheets("Tabelle1")
letzteZeile = ws.Cells.SpecialCells(xlLastCell).Row
Do
strOft = InputBox(Prompt:="Bitte eine Ganzzahl eingeben.", _
Title:=titel, _
Default:=strOft)
If strOft = "" Then
MsgBox Prompt:="Benutzerabbruch", _
Title:=titel
Exit Sub
End If
If Not EnthältNurZiffern(strOft) Then
MsgBox Prompt:="Der eingegebene Wert: '" & _
strOft & "' enthält nicht nur Ziffern", _
Title:=titel
Else
' Wert enthält nur Ziffern und kann max. 254 Stellen haben,
' daher kann in eine Double-Variable konvertiert werden.
dblOft = CDbl(strOft)
If dblOft = 0 Then
MsgBox Prompt:="Der eingegebene Wert: '" & _
strOft & "'" & vbNewLine & _
"ist = 0", _
Title:=titel
Else
If letzteZeile + dblOft > ws.Rows.Count Then
MsgBox Prompt:="Der eingegebene Wert: '" & _
strOft & "'" & vbNewLine & _
"sprengt das Zeilengefüge!", _
Title:=titel
Else
' Der eingegebene Wert ist OK und
' wird in Long konvertiert
lngOft = CLng(dblOft)
Exit Do
End If
End If
End If
Loop
' Zeileneinfügung
ws.Range(ws.Rows(Wo), ws.Rows(Wo + lngOft - 1)).Insert
End Sub
Function EnthältNurZiffern(Text) As Boolean
Dim i As Long
Dim j As Long
Dim zifferOK As Boolean
EnthältNurZiffern = True
For i = 1 To Len(Text)
zifferOK = False
For j = 0 To 9
If Mid$(Text, i, 1) = CStr(j) Then
zifferOK = True
Exit For
End If
Next j
If Not zifferOK Then
EnthältNurZiffern = False
Exit Function
End If
Next i
End Function
Viele Grüße
Dieter