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
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.
Hallo,
Sub Makro1()
With Range("B2")
.Value = (.Value Mod 3) + 1
End With
End Sub
Gruß Uwe
Hallo,
ich habe die Fraage heute morgen woh komplett falsch verstanden. Sorry. Mein Beitrag ist überflüssig.
Gruß
Marcus
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.
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