Änderung von Einträgen nach Eingabe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Function Druck_setzen(ByVal k As Integer, ByVal j As Integer) For i = 1 To 14 'Spalten If k = 7 Then 'die 7 Tagewoche sp = Chr(65 + i) Application.Range(sp & j + 3).Value = "x" ElseIf k = 6 Then 'die 6 Tagewochen If i = 7 Or i = 14 Then Else sp = Chr(65 + i) Application.Range(sp & j + 3).Value = "x" End If ElseIf k = 5 Then 'Die 5 Tagewoche If i < 6 Or i > 7 And i < 13 Then sp = Chr(65 + i) Application.Range(sp & j + 3).Value = "x" End If ElseIf k = 3 Then 'Die 3 Tagewoche If i = 1 Or i = 3 Or i = 5 Or i = 8 Or i = 10 Or i = 12 Then sp = Chr(65 + i) Application.Range(sp & j + 3).Value = "x" End If ElseIf k = 2 Then Application.Range("B" & j + 3).Value = "x" Application.Range("D" & j + 3).Value = "x" Application.Range("F" & j + 3).Value = "x" Application.Range("I" & j + 3).Value = "x" Application.Range("K" & j + 3).Value = "x" End If Next i End Function

Private Sub Worksheet_Change(ByVal Target As Range) Dim a As Integer If Target.Column <> 1 Then Exit Sub If Not IsNumeric(Target.Value) Then Exit Sub If Target.Value > 7 Then Application.EnableEvents = False Target.Value = "" Application.EnableEvents = True MsgBox "Bitte max '7' eingeben" Exit Sub End If For a = 2 To Target.Value + 1 Cells(Target.Row, a).Value = "x" Next a End Sub

Hi,
hab ich das richtig verstanden: bei Eingabe von 2, 3 oder 4 sollen entsprechend 2, 3 oder 4 Kreuzchen zufällig auf die 7 Spalten verteilt werden? Und bei 1, 5, 6 und 7 bleibt alles beim alten?
Eine Art Zufallsverteilung bekommt man mit folgendem Code hin, ob das einer strengen statistischen oder stochastischen Überprüfung standhält kann ich aber leider nicht beurteilen.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Integer
Dim b As Integer
b = 0
If Target.Column <> 1 Then Exit Sub
If Not IsNumeric(Target.Value) Then Exit Sub
If Target.Value > 7 Then
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True
MsgBox "Bitte max '7' eingeben"
Exit Sub
End If
Select Case Target.Value
Case 2, 3, 4
For a = 2 To 8
If 8 - a < Target.Value - b Then
Cells(Target.Row, a).Value = "x"
Else
If Rnd() > (1 / 7) * Target.Value Then
Cells(Target.Row, a) = "x"
b = b + 1
End If
End If
If b = Target.Value Then Exit Sub
Next a
Case Else
For a = 2 To Target.Value + 1
Cells(Target.Row, a).Value = "x"
Next a
End Select
End Sub

Schönen Gruß,
Andi

Beliebteste Forumthreads (12 Monate)

Änderung von Einträgen nach Eingabe

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

240 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Änderung von Einträgen nach Eingabe

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

240 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread