Makro mit Inputbox ergänzen

Question

Hallo Makrospezies,
das folgende sehr nützliche Makro wurde mit Hilfe von hier erstellt:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngRange As Range
On Error Resume Next
Set rngRange = ThisWorkbook.Worksheets("Listen").Range(Target.Value)
On Error GoTo 0
If Not rngRange Is Nothing Then
Application.EnableEvents = False
Target = rngRange.Value
Application.EnableEvents = True
End If
Set rngRange = Nothing
End Sub
Wenn in eine Zelle eine gültige Zelladresse eingegeben wurde soll noch nicht der Wert aus der Tabelle "Listen" übernommen werden, sondern es soll per Inputbox abgefragt werden, ob auf einen Bereich ausgeweitet werden soll. Habe ich also in eine Zelle z.B. C3 eingegeben, dann soll in der Eingabezeile der Inputbox C3:C3 als Vorgabe stehen, die ich ggf. z.B. auf C3:D4 ändere, so das Werte aus 4 Zelle in 4 Zellen der aktiven Tabelle übernommen werden.
Geht das?
Vielen Dank im Voraus
mfg
Wolfgang

Answer 1

Hi Wolfgang,

vielleicht so:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngRange As Range
Dim rngInput As Range
On Error Resume Next
Set rngRange = Range(Target)
On Error GoTo 0
If Not rngRange Is Nothing Then
On Error Resume Next
Set rngInput = Application.InputBox(prompt:="Bereich", Default:=Target & ":" & Target, Type:=8)
If Err.Number = 0 Then
MsgBox rngInput.Address
End If
Err.Clear
End If
Set rngRange = Nothing
Set rngInput = Nothing
End Sub

Bis später,
Karin

Answer 2

Guten Morgen Karin, und auch alle anderen,
vielen Dank für dein bemühen. Die Zeile, die die Inputbox aufruft hilft schon mal weiter. Da aber in das Tabellenblatt sowohl vorgefertigte Textbausteine aus dem Tabellenblatt "Listen", als auch individuelle Daten eingegeben werden müssen, sollte die Inputbox nur auftauchen, wenn das Eingegebene tatsächlich als Zelladresse zu gebrauchen ist.

Answer 3

Hi Wolfgang,

genau das macht die InputBox doch auch - gibst du z.B. "Hallo" ein, passiert nichts, gibst du "C1" ein, erscheint sie.

Allerdings hat der Code noch einen Fehler - der Bereich wird nicht korrekt wiedergegeben. So sollte er jetzt korrekt sein:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngRange As Range
Dim rngInput As Range
On Error Resume Next
Set rngRange = Range(Target)
On Error GoTo 0
If Not rngRange Is Nothing Then
On Error Resume Next
Set rngInput = Range(Application.InputBox(prompt:="Bereich", Default:=Target & ":" & Target))
If Err.Number = 0 Then
MsgBox rngInput.Address
End If
Err.Clear
End If
Set rngRange = Nothing
Set rngInput = Nothing
End Sub

Bis später,
Karin

Answer 4

Hallo Karin,
nochmal Danke.
Pfingsten war ich nicht am PC und heute musste ich bisher erstmal das Tagesgeschäft erledigen.
Ich muss gleich Feierabend machen, morgen lade ich eine Beispiel-Datei hoch.
mfg
Wolfgang

Answer 5

Hallo alle zusammen,
http://www.file-upload.net/download-3509898/Text-per-Makro.xls.html">
http://www.file-upload.net/download-3509898/Text-per-Makro.xls.html

die Datei unter obigem Downloadlink enthält ein Tabellenblatt mit meinem obigem Makro, ein weiteres mit einer Variante1 davon und ein Tabellenblatt mit der unvollendeten Variante2. Die Input- und die MsgBox habe ich da schon integriert, das Übernehmen von Daten aus einem ZellBereich klappt aber (noch) nicht.

Außerdem ist ein Tabellenblatt Erläuterung enthalten. Ich hoffe dann wird deutlich was meine eigentliche Absicht ist.

Bin für jede Hilfe dankbar.

mfg

Wolfgang

Answer 6

Hi Wolfgang,

der Link funktioniert nicht.

Bis später,
Karin

Answer 7

www.file-upload.net/download-3509898/Text-per-Makro.xls.html

Dieser hoffentlich

Wolfgang

Answer 8

Hi Wolfgang,

was soll man mit einer Arbeitsmappe anfangen, wo alles mögliche enthalten ist und man erst stundenlang suchen muss wo da überhaupt ein Problem liegen soll? Da steht ja nicht mal, wo man etwas eingeben muss. Sorry, da ist mir der Auswand, überhaupt erst einmal herauszufinden was du da machen willst einfach zu groß.

Bis später,
Karin