automatische Eingabehilfe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Write_Cells() Dim i As Integer ' Loescht den Inhalt in den Zellen Range("C6:C26").Select Selection.Delete ' Schreibt die gewuenschten Zahlen For i = 1 To Cells(2, 3) Cells(6 + (i - 1), 3).FormulaR1C1 = i Next End Sub

Private Sub CommandButton1_Click() Dim i As Integer ' Loescht den Inhalt in den Zellen Range("A6:A26").Select Selection.Delete ' Schreibt die gewuenschten Zahlen For i = 1 To Cells(2, 3) Cells(6 + (i - 1), 1).FormulaR1C1 = i Next End Sub

Hallo Robag,
dann versuch es einmal so:

'
'   Ein Makro das folgendes ausführt:
'   In Zelle C2 wird eine Zahl geschrieben (die Zahl liegt zwischen 1 bis 20).
'   Aufgrund dieser Zahl soll jetzt automatisch in Zelle A6 eine 1,
'   in Zelle A7 eine 2, in Zelle A8 eine 3 usw geschrieben werden,
'   das soll solange fortgeführt werden bis der Wert von C2 erreicht ist.
'
Sub Zahlen_schreiben()
Dim lLetzte   As Long
Dim iIndx     As Integer
   If IsNumeric(Range("C2").Value) And _
      Range("C2").Value > 0 And _
      Range("C2").Value < 21 Then                ' gültiger Wert in 'C2' ?
      lLetzte = IIf(Range("A65536") <> "", 65536, Range("A65536").End(xlUp).Row)
      For iIndx = 6 To lLetzte                   ' nur Zeilen bei Wert in A löschen
         Rows(iIndx & ":" & iIndx).ClearContents
      Next iIndx
      For iIndx = 1 To Range("C2").Value         ' Zahlen eintragen
         Cells(iIndx + 5, 1).Value = iIndx
      Next iIndx
    Else                                         ' ungültiger Inhalt in 'C2' !
      MsgBox "die Eingabe in Zelle 'C2' ist entweder nicht numerisch" & vbLf _
           & "          oder kleiner als 1 bzw. gößer als 20." & vbLf & vbLf _
           & "bitte geben sie einen gültigen Wert ein - danke.", _
           64, "fehlerhafte Eingabe in Zelle 'C2'."
   End If
   Range("C2").Select                            ' Cursor auf 'C2' setzen.
End Sub

Gruß Peter

Hallo Robag,
es geht auch so:

'
'   Ein Makro das folgendes ausführt:
'   In Zelle C2 wird eine Zahl geschrieben (die Zahl liegt zwischen 1 bis 20).
'   Aufgrund dieser Zahl soll jetzt automatisch in Zelle A6 eine 1,
'   in Zelle A7 eine 2, in Zelle A8 eine 3 usw geschrieben werden,
'   das soll solange fortgeführt werden bis der Wert von C2 erreicht ist.
'
'   Die Zeilen (Bereich A6 bis IV25) sollen nur dann gelöscht werden, wenn in
'   der ersten Zelle (A6 bis A25) eine Zahl steht.
'   Sobald eine leere Zelle A kommt darf die Zeile nicht mehr gelöscht werden.
'
Sub Zahlen_schreiben()
Dim iIndx     As Integer                         ' Allround Index
   If IsNumeric(Range("C2").Value) And _
      Range("C2").Value > 0 And _
      Range("C2").Value < 21 Then                ' gültiger Wert in 'C2' ?

      iIndx = 6                                  ' beginnen in Zeile 6
      Do                                         ' wiederholen.....
         Rows(iIndx & ":" & iIndx).ClearContents ' Zeilen löschen
         iIndx = iIndx + 1                       ' nächste Zeile errrechnen
      Loop Until Range("A" & iIndx) = ""         ' aufhören, wenn A leer ist

      For iIndx = 1 To Range("C2").Value         ' Zahl 1 bis Inhalt von 'C2'
         Cells(iIndx + 5, 1).Value = iIndx       ' Zahlen eintragen
      Next iIndx                                 ' nächste Zahl
    Else                                         ' ungültiger Inhalt in 'C2' !
      MsgBox "die Eingabe in Zelle 'C2' ist entweder nicht numerisch" & vbLf _
           & "          oder kleiner als 1 bzw. gößer als 20." & vbLf & vbLf _
           & "bitte geben sie einen gültigen Wert ein - danke.", _
           64, "fehlerhafte Eingabe in Zelle 'C2'."
   End If                                        ' so und so fertig.

   Range("C2").Select                            ' Cursor auf 'C2' setzen.
End Sub

Gruß Peter

Private Sub Worksheet_Change(ByVal Target As Range) Dim iIndx As Integer ' Allround Index If Target.Address = "$C$2" Then Application.ScreenUpdating = False If IsNumeric(Range("C2").Value) And _ Range("C2").Value > 0 And _ Range("C2").Value < 21 Then ' gültiger Wert in 'C2' ? iIndx = 6 ' beginnen in Zeile 6 Do ' wiederholen..... Rows(iIndx & ":" & iIndx).ClearContents ' Zeilen löschen iIndx = iIndx + 1 ' nächste Zeile errrechnen Loop Until Range("A" & iIndx) = "" ' aufhören, wenn A leer ist For iIndx = 1 To Range("C2").Value ' Zahl 1 bis Inhalt von 'C2' Cells(iIndx + 5, 1).Value = iIndx ' Zahlen eintragen Next iIndx ' nächste Zahl Else ' ungültiger Inhalt in 'C2' ! MsgBox "die Eingabe in Zelle 'C2' ist entweder nicht numerisch" & vbLf _ & " oder kleiner als 1 bzw. gößer als 20." & vbLf & vbLf _ & "bitte geben sie einen gültigen Wert ein - danke.", _ 64, "fehlerhafte Eingabe in Zelle 'C2'." End If ' so und so fertig. Range("C2").Select ' Cursor auf 'C2' setzen. End If End Sub

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

automatische Eingabehilfe

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread