Im Kreis hochzählen (bis zu festgelegtem Limit)

[Excel_Newbi]

Hallo, 

ich möchte einer Zelle durch einen Druck eines Buttons einen um Eins höheren Zellwert zuweisen, bis ein Maximalwert erreicht ist, und dann wieder bei Eins anfangen. Mit einem Maximalwert von 3 sollten also durch Druck des Buttons in der betreffenden Zelle die Zahlen in folgender Reihenfolge erscheinen: 1, 2, 3, 1, 2, 3, 1, 2, 3, ....usw. usf.

Habe leider keinen Schimmer, wie ich das hinkriegen kann.
Grüßle
Newbi

[WillWissen]

Moin,

folgenden Code hinters Arbeitsblatt:

Code:

Option Explicit

Private Sub CommandButton1_Click()
Dim value As Single
    value = value + 1
        If Range("A1").value >= 5 Then
        Range("A1").value = 0
        End If
    Range("A1") = Range("A1") + 1
End Sub

Aktuell wird mit diesem Makro in Zelle A1 bis 5 gezählt. Du musst das ggfls. auf deine Bedürfnisse anpassen.

[marose67]

Hallo,

so?
Tabelle1

	A	B	C	D	E	F
1	g	g	g	g	g	gg
2	1	2	3	1	2	3

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

Option Explicit

Sub Schaltfläche1_Klicken()
Dim Loletzte As Long
Dim i As Integer
    i = 0
        For Loletzte = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
        i = i + 1
            If i > 3 Then i = 1
        Cells(2, Loletzte) = i
        Next
End Sub

Gruß
Marcus

[Kuwer]

Hallo,

Sub Makro1()
  With Range("B2")
    .Value = (.Value Mod 3) + 1
  End With
End Sub

Gruß Uwe

[marose67]

Hallo,
ich habe die Fraage heute morgen woh komplett falsch verstanden. Sorry. Mein Beitrag ist überflüssig.

Gruß
Marcus

[atilla]

Hallo zusammen,

ich habe es auch so ähnlich verstanden wie Markus.
Nach meinem Verständnis soll aber alles in eine Zelle geschrieben werden und nicht in einzelne.

Unten stehender Code reiht die in Zelle A1 stehende Zahl entsprechen oft in Zelle B2 auf.

Code:

Sub wiederholen()

Dim lngZahl As Long
Dim strgZahl As String
Dim a As String

    lngZahl = Cells(1, 1)

    If lngZahl > 0 Then
        For i = 1 To lngZahl
            strgZahl = strgZahl & "," & i
         Next i
         strgZahl = Right(strgZahl, Len(strgZahl) - 1) & ","
        
        With Range("B2")
            .ClearContents
            For i = 1 To lngZahl
               a = a & strgZahl
            Next i
             a = Right(a, Len(a)) & ","
             If Len(a) >= 32761 Then
                MsgBox "Die Textlänge ist größer als die maximal mögliche Zeichenanzahl für eine Zelle." & vbLf _
                & vbLf & "Möglicherweise werden Zeichen abgeschnitten"
            End If
            .Value = a
        End With
       
    End If
   
End Sub

Zuerst habe ich es mit der WorksheetFunction.Rept() versucht umzusetzen. Jedoch hat diese anscheinend ein Limit. Da ich nicht weiß, wo der Limit liegt, habe ich es mit der Schleife realisiert.

[schauan]

Hallöchen,

ich hab hier mal meine Auffassung der Aufgabe Ist auch wieder fest auf B2 programmiert - könnte man durch ActiveCell ersetzen. Fehlerbetrachtungen sind nicht enthalten, z.B. leere Zelle, nur eine Zahl in Zelle, Text in Zelle, falsches Trennzeichen, Zeichenanzahl …
Lediglich eventuelle Leerzeichen werden entfernt.

Code:

Sub Makro3()
'Variablendeklarationen
Dim arrZahlen, iMax%, iCnt%
'von Leerzeichen befreiten Zellinhalt von B2 uebernehmen und in ein Array ueberfuehren
arrZahlen = Split(Replace([b2], " ", ""), ",")
'max feststellen
'Schleife ueber alle Zahlen
For iCnt = 0 To UBound(arrZahlen)
  'wenn die Zahl kleiner als imax ist, dann
  If WorksheetFunction.Max(arrZahlen(iCnt)) < iMax Then
    'Schleife verlassen
    Exit For
  'oder iMax hochsetzen
  Else: iMax = WorksheetFunction.Max(arrZahlen(iCnt))
  'Ende wenn die Zahl kleiner als imax ist, dann
  End If
'Ende Schleife ueber alle Zahlen
Next
'Array erweitern
ReDim Preserve arrZahlen(UBound(arrZahlen) + 1)
'wenn die letzte Zahl die groesste ist, dann
If Val(arrZahlen(UBound(arrZahlen) - 1)) = iMax Then
  'Array mit 1 erweitern
  arrZahlen(UBound(arrZahlen)) = 1
'oder wenn nicht,
Else
  'Array mit letzter Zahl + 1 erweitern
  arrZahlen(UBound(arrZahlen)) = arrZahlen(UBound(arrZahlen) - 1) + 1
'Ende wenn die letzte Zahl die groesste ist, dann
End If
'Zahlenfolge in B2 eintragen
Range("B2").Value = Join(arrZahlen, ",")
End Sub