Office: 1 mal 1

Hallo alle miteinander...

Möchte eine Tabelle erstellen wo man das ein mal eins genereieren kann.
Also ich meine es so...



aber es soll auch verstellbar sein. also nicht nur 5x5 wie in dem Bild, sondern auch evtl. 2x10 oder 8x4, und man sollte die Höchstzahl (für das Ergebnis) einstellen können.

Wäre schön wenn Ihr mir helfen könntet.

Gruß Paffy

 

Hallo!

Teste mal diese Codes:
Für die Zeilen- und Spaltenköpfe werden Zahlen zwischen 1 und der abgerundeten Wurzel des Maximums gewählt.
Doppelte Werte in den Zeilen- und Spaltenköpfen werden vom Code NICHT zugelassen!
Beachte dies bei der Wahl des Maximums und der Wahl der Ausmaße der Matrix; bei Unmöglichkeiten läuft der Code auf einen Fehler!
Die Technik des "Aufruf"-Makros ist dir ja aus dem anderen Thread bekannt; hier mit entsprechend geänderten Parametern.

Code:

Sub EinMalEins(Höhe%, Breite%, Maximum&, Beginn As Range)
Dim Bereich As Range, Zelle As Range, i%, j%, a, b
ReDim a(1 To Fix(Sqr(Maximum)))
ReDim b(1 To Höhe + Breite)
For i = 1 To UBound(a)
a(i) = Rnd
Next i
For i = 1 To UBound(b)
For j = 1 To UBound(a)
If a(i) >= a(j) Then b(i) = b(i) + 1
Next j
Next i
Set Bereich = Beginn.Offset(1, 1).Resize(Höhe, Breite)
For i = 1 To Höhe
Beginn.Offset(i, 0) = b(i)
Next i
For i = Höhe + 1 To Breite + Höhe
Beginn.Offset(0, i - Höhe) = b(i)
Next i
For Each Zelle In Bereich
Zelle = Cells(Zelle.Row, Beginn.Column) * Cells(Beginn.Row, Zelle.Column)
Next Zelle
End Sub

Sub Aufruf()
EinMalEins 4, 5, 99, [b6]
EinMalEins 6, 5, 999, [c25]
End Sub

 

Hallo Schatzi...

Super, danke...
Klappt wie immer super..

wenn ich das könnte, wäre ich viel erleichterter...
dann würde ich das auch für - und : auch machen...
für Plus habe ich es geschaft

Grüße Paffy

 

es wäre aber schön wenn ich das kleine 1x1 wenigstens komplett bekommen könnte.
Beim großen ist es mir egal...
aber ab und wann wäre das komplette schon ganz von vorteil !



das es da durcheinander gehen kann wäre auch ok, das soll ja der Sinn und Zweck sein...

wenigstens beim kleinen bitte das 10x10 einrichten, danke....

MfG Paffy

 

Hallo!

Schreibe in A1 die Formel
=ZEILE()*SPALTE()
und kopiere sie so weit nach unten/rechts wie du möchtest.
Dann hast du kleine, mittlere, große, ganz große und auch riesengroße 1x1 zur Verfügung.

 

aha, aber somit lass ich ja keine zufallszahlen generieren.

Paffy

 

Hallo!

Zufallszahlen sind zufällig, deshalb heißen sie so...
Deine Anfrage war aber diese:

Bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte, bitte lass dies nicht wieder zu einer solch endlos langen Auseinandersetzung wie beim letzten Mal werden!

Bitte, bitte, bitte NICHT!

 

Das stand zwar noch darunter, aber gut, danke...

Paffy

 

Hallo nochmal....

Brauche nur hilfe...
was muss ich bei dem Script einsetzen, das ich eine 2. und 3. usw. Tabelle versetzt erstellen kann.

Code:

Sub test()
Const G = 10
Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, f As Integer, h As Integer, i As Integer, j As Integer, k As Integer, l As Integer
a = 1
b = 2
c = 3
d = 4
e = 5
f = 6
h = 7
i = 8
j = 9
k = 10
l = Fix(G * Rnd) + 1
Range("BT1") = a
Range("BU1") = b
Range("BV1") = c
Range("BW1") = d
Range("BX1") = e
Range("BY1") = f
Range("BZ1") = h
Range("CA1") = i
Range("CB1") = j
Range("CC1") = k
Range("BS2") = l
Range("BT2") = a * l
Range("BU2") = b * l
Range("BV2") = c * l
Range("BW2") = d * l
Range("BX2") = e * l
Range("BY2") = f * l
Range("BZ2") = h * l
Range("CA2") = i * l
Range("CB2") = j * l
Range("CC2") = k * l
End Sub

Danke Paffy

 

Hallo!

Hier ein Code für ein komplettes 1x1 variabler Größe in zufälliger Reihenfolge:

Code:

Sub Komplett(M%, Beginn As Range)
Dim i%, j%, a1, b1, a2, b2, x
ReDim a1(1 To M): ReDim b1(1 To M)
ReDim a2(1 To M): ReDim b2(1 To M)
ReDim x(1 To M, 1 To M)
For i = 1 To M
a1(i) = Rnd: b1(i) = Rnd
Next i
For i = 1 To M
For j = 1 To M
If a1(i) >= a1(j) Then a2(i) = a2(i) + 1
If b1(i) >= b1(j) Then b2(i) = b2(i) + 1
Next j
Next i
Beginn.Offset(0, 1).Resize(1, M) = a2
Beginn.Offset(1, 0).Resize(M, 1) = WorksheetFunction.Transpose(b2)
For i = 1 To M
For j = 1 To M
x(i, j) = a2(j) * b2(i)
Next j
Next i
Beginn.Offset(1, 1).Resize(M, M) = x
End Sub

Sub Aufruf1()
Komplett 9, [a18]
Komplett 22, [c44]
End Sub

 

Ja danke....

ist zwar jetzt nicht mehr einstellbar auf verschiede Größen.

Paffy