Clever-Excel-Forum

Seiten: 1 2 3 4 5 6

Nicht nötig ;)
Es geht so:

Code:
Sub M_snb()

   If Tabelle1.Shapes.Count = 0 Then

        sn = Array(0, 5, 11, 18, 26, 35, 43, 50, 56, 61, 70)

        For j = 0 To 60

           y = Application.Match(j, sn, 1) - 1

           With Tabelle1.Shapes

                c00 = "C_" & Format(j, "00")

                With .AddShape(10, 259 - IIf(y < 5, y, 8 - y) * 69 / 2 + (j - sn(y)) * 69, 30 + y * 60, 68.25, 0.885 * 68.25)

                  .Name = c00

                  .Rotation = 27

                  .LockAspectRatio = True

                End With

                With .AddLabel(1, Tabelle1.Shapes(c00).Left + 6, Tabelle1.Shapes(c00).Top + 15, 58, 33).TextFrame

                    .Parent.Name = "T_" & Format(j, "00")

                    .AutoSize = False

                    .MarginLeft = 4

                    .MarginRight = 0

                    .MarginBottom = 0

                    .MarginTop = 0

                    .VerticalAlignment = -4108

                    .HorizontalAlignment = -4108

                    .Characters.Font.Color = RGB(0, 0, 0)

                End With

            End With

        Next

    End If

   sn = Tabelle2.Cells(1).CurrentRegion

   y = Abs(Int(6 * Rnd() - 0.01)) + 1

   For j = 1 To UBound(sn)

     If sn(j, y) = "" Then Exit For

   Next

    For jj = 0 To 60

        Tabelle1.Shapes("C_" & Format(jj, "00")).Fill.ForeColor.RGB = RGB(200, 200, 200)

        With Tabelle1.Shapes("T_" & Format(jj, "00")).TextFrame.Characters

           .Text = sn(Abs(Int((j - 2) * Rnd() - 0.01)) + 2, y)

           .Font.Color = RGB(0, 0, 0)

         End With

    Next

   With Tabelle1

       .[K1:K61] = "=rand()"

        sp = [index(rank(T_OLE!K1:K61,T_OLE!K1:K61)-1,)]

       .[K1:K61].ClearContents

    End With

    For j = 1 To 14

       Tabelle1.Shapes("C_" & Format(sp(j, 1), "00")).Fill.ForeColor.RGB = IIf(sp(j, 1) < 27, RGB(0, 0, 255), IIf(sp(j, 1) < 38, RGB(200, 100, 0), RGB(100, 100, 100)))

       Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(255, 255, 255)

    Next

End Sub

Hi,

Klasse, nur die bunten Felder haben nicht gepasst. Das habe ich angepasst:

Code:
Private Sub worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)

    Dim sn

    Dim j As Long

    Dim y As Long

    Dim c00 As String

    Dim jj As Long

    Dim loC As Long

    Dim loB As Long

    Dim arrzahlen

    Dim arrzahlen2

    Dim sp

    If Target.Address <> "$M$2" Then Exit Sub

    cancel = True

    Tabelle1.DrawingObjects.Delete

   If Tabelle1.Shapes.Count = 0 Then

        sn = Array(0, 5, 11, 18, 26, 35, 43, 50, 56, 61, 70)

        For j = 0 To 60

           y = Application.Match(j, sn, 1) - 1

           With Tabelle1.Shapes

                c00 = "C_" & Format(j, "00")

                With .AddShape(10, 259 + IIf(y < 5, 0, 8 + (y - 6) * 5) - IIf(y < 5, y, 8 - y) * 55 / 2 + (j - sn(y)) * 63, 30 + y * 53, 70, 0.885 * 69)

                  .Name = c00

                  .Rotation = 27

                  .LockAspectRatio = True

                End With

                With .AddLabel(1, Tabelle1.Shapes(c00).Left + 6, Tabelle1.Shapes(c00).Top + 15, 58, 33).TextFrame

                    .Parent.Name = "T_" & Format(j, "00")

                    .AutoSize = False

                    .MarginLeft = 0

                    .MarginRight = 0

                    .MarginBottom = 0

                    .MarginTop = 0

                    .VerticalAlignment = -4108

                    .HorizontalAlignment = -4108

                    .Characters.Font.Color = RGB(0, 0, 0)

                End With

            End With

        Next

    End If

   sn = Tabelle2.Cells(1).CurrentRegion

   y = Abs(Int(6 * Rnd() - 0.01)) + 1

   For j = 1 To UBound(sn)

     If sn(j, y) = "" Then Exit For

   Next

    For jj = 0 To 60

        Tabelle1.Shapes("C_" & Format(jj, "00")).Fill.ForeColor.RGB = RGB(220, 220, 220)

        With Tabelle1.Shapes("T_" & Format(jj, "00")).TextFrame.Characters

           .Text = sn(Abs(Int((j - 2) * Rnd() - 0.01)) + 2, y)

           .Font.Color = RGB(0, 0, 0)

         End With

    Next

   With Tabelle1

       .[N1:N61] = "=rand()"

        sp = [index(rank(T_OLE!N1:N61,T_OLE!N1:N61)-1,)]

        .Range("P1:P61") = sp

       .[N1:N61].ClearContents

    End With

    For j = 1 To 12

       Tabelle1.Shapes("C_" & Format(sp(j, 1), "00")).Fill.ForeColor.RGB = RGB(0, 0, 255)

       Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(255, 255, 255)

    Next

    For j = 13 To 16

       Tabelle1.Shapes("C_" & Format(sp(j, 1), "00")).Fill.ForeColor.RGB = RGB(200, 100, 0)

       Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(255, 255, 0)

    Next

       Tabelle1.Shapes("C_" & Format(sp(17, 1), "00")).Fill.ForeColor.RGB = RGB(100, 100, 100)

       Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(0, 0, 0)

End Sub

Makro wurde 2x verändert!

Bitte:

Analysiere mal erst diese Code:

Code:
    .[K1:K61] = "=rand()"

    sp = [index(rank(T_OLE!K1:K61,T_OLE!K1:K61)-1,)]

    .[K1:K61].ClearContents

Hi,

ob ich den analysiere oder nicht, ich kriege die Felder nicht, die ich brauche: 12x blau, 4x braun und 1x grau.

Das ist der falsche Ansatz:

Code:
For j = 1 To 14

       Tabelle1.Shapes("C_" & Format(sp(j, 1), "00")).Fill.ForeColor.RGB = IIf(sp(j, 1) < 27, RGB(0, 0, 255), IIf(sp(j, 1) < 38, RGB(200, 100, 0), RGB(100, 100, 100)))

       Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(255, 255, 255)

    Next

End Sub

Habe den Code nochmals angepasst.

[attachment=16090]

Eine neue 'Glaskugelbedingung' ?

Code:
   With Tabelle1

       .[K1:K61] = "=rand()"

        sp = [index(rank(T_OLE!K1:K61,T_OLE!K1:K61)-1,)]

       .[K1:K61].ClearContents

    End With

    st = Array(0, 0, 0)

    For j = 1 To UBound(sp)

       If (sp(j, 1) < 27) * (st(0) < 12) + (sp(j, 1) > 26) * (sp(j, 1) < 37) * (st(1) < 4) + (sp(j, 1) > 26) * (st(2) < 1) <> 0 Then

        st(0) = st(0) - (sp(j, 1) < 27)

        st(1) = st(1) + ((sp(j, 1) > 26) * (sp(j, 1) < 38))

        st(2) = st(2) - (sp(j, 1) > 37)

        Tabelle1.Shapes("C_" & Format(sp(j, 1), "00")).Fill.ForeColor.RGB = IIf(sp(j, 1) < 27, RGB(0, 0, 255), IIf(sp(j, 1) < 38, RGB(200, 100, 0), RGB(100, 100, 100)))

        Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(255, 255, 255)

       End If

Hi,

Zitat:Eine neue 'Glaskugelbedingung' ?

siehe Beitrag #16

da sp aus zufällig angeordneten Zahlen zwischen 1 u. 61 besteht, nehme ich die ersten 12 und mache die entsprechenden Felder blau, die nächsten 4 braun und das letzte grau. Das passt wunderbar.

Code:
For j = 1 To 17

       Tabelle1.Shapes("C_" & Format(sp(j, 1), "00")).Fill.ForeColor.RGB = IIf(j < 13, RGB(0, 0, 255), IIf(j < 17, RGB(200, 100, 0), RGB(100, 100, 100)))

       Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(255, 255, 255)

    Next

Außerdem muß ich eines der Themen aus der Liste zufällig auswählen, nach dem richtet sich die Belegung der Felder. Du hast die Zuordnung der Zahlen aus der Liste zu den Begriffen gelöscht. Die waren aber von Thema zu Thema unterschiedlich. Manche Zahlenbereiche waren größer, andere kleiner, was eine Wichtung bei Zufallszahlen bewirkt.

In #16 erwähnst du 9 Blaue Felder ???

Letztendlich reicht dann doch:

Code:
   With Tabelle1

       .[K1:K61] = "=rand()"

        sp = [index(rank(T_OLE!K1:K61,T_OLE!K1:K61)-1,)]

       .[K1:K61].ClearContents

    End With

    For j = 1 To 17

        Tabelle1.Shapes("C_" & Format(sp(j, 1), "00")).Fill.ForeColor.RGB = IIf(j < 13, RGB(0, 0, 255), IIf(j < 17, RGB(200, 100, 0), RGB(100, 100, 100)))

        Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(255, 255, 255)

    Next

Hi,

ja, so habe ich es auch mittlerweile in meinem Code stehen. Es waren zuerst 9, später dann 12 blaue Felder. Das ist aber nur eine Marginalie, am System ändert sich nichts.

Zitat:Die waren aber von Thema zu Thema unterschiedlich.
Manche Zahlenbereiche waren größer, andere kleiner, was eine Wichtung bei Zufallszahlen bewirkt.

Und das gerade versteh ich nicht.

Basiert auf zufall wird Gruppe 1,2,3,4,5 oder 6 gewählt.
Dann werden die 'items' der gewählte Gruppe basiert auf Zufall den 61 'Felder' zugewiesen ?

Oder ??

Hi,

prinzipiell hast Du recht. Aber, es werden Zufallszahlen in einem Bereich von 1 bis 200 ausgewürfelt. Diese Zahlen werden einem Begriff zugeordnet:

Arbeitsblatt mit dem Namen 'Liste'
	E	F	G	H
1	Statistics Elysium Board		The Wasteland
2	1	Empty	1	Empty
3	62	Steel	108	2 Heat
4	78	2 Steel	131	3 Heat
5	91	Titan	144	Card
6	101	2 Titan	154	Steel
7	104	Plant/Steel	174	2 Steel
8	107	Plant/Titan	181	Titan
9	110	Plant	188	Plant
10	153	2 Plants
11	179	3 Plants
12	182	Card
13	198	3 Cards

Du siehst also, dass die Zahlenbereiche (von denen ich hier nur die Startzahl stehen habe) unterschiedlich sind. Die Wahrscheinlichkeiten für das Auftreten der einzelnen Begriffe sind also unterschiedlich hoch. Das muß einfach im Code implementiert sein.

Seiten: 1 2 3 4 5 6

snb

BoskoBiati

snb

BoskoBiati

snb

BoskoBiati

snb

BoskoBiati

snb

BoskoBiati