Sprechtafel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Sprechtafel

28.07.2017 08:14:06

UweD

AW: Sprechtafel

28.07.2017 09:42:14

Maruxxx

AW: Sprechtafel

28.07.2017 10:50:06

UweD

AW: Sprechtafel

28.07.2017 13:44:24

UweD

Im ersten Step muss ich den Bereich Numeral-Code von B4 bis N16 auf Wunsch per Button neu generieren.
Die nachfolgenden Zahlen sollen sich numerisch bis 9 erhöhen. Nach 9 beginnend mit dem Alphabet (wie im Bild zu sehen) aber nur vier Buchstaben dann wieder 0-9, anschließend weiterführend das unterbrochene Alphabet. Genial wäre natürlich wenn zeitgleich sich die Buchstabenreihe in 3 und Spalte A ebenso neu generieren. Es dürfen sich in der y und x Achse keine Buchstaben wiederholen.
Das Feld B4 bekomm ich mit nem Button hin aber wie soll sich der Rest denn logisch mitverändern?
Den Autentisierungsbereich natürlich analog dem Numeral-code, wobei hier nur Zahlen im zweistelligen Bereich von 10-99 ohne Logig zu generieren sind.
Sorry, für mich noch zu hoch....

Sub Num_code() Dim SP As Integer, ZE As Integer, WE As Integer, K As Integer, LB As Integer WE = 48 Range("B4:N16").ClearContents For ZE = 4 To 16 For SP = 2 To 14 Cells(ZE, SP) = Chr(WE) If Not IsNumeric(Chr(WE)) Then K = K + 1 If K = 4 Then 'nach 4 Buchstaben M = 1 LB = WE 'Letzer Buchstabe merken WE = 47 'Zahlen einschieben K = 0 End If If WE = 57 Then K = 0 If M = 0 Then WE = 65 Else WE = LB + 1 End If ElseIf WE = 90 Then LB = 64 WE = 48 Else WE = WE + 1 End If Next SP Next ZE End Sub

Hallo nochmal
so?

Sub Num_code()
    Dim SP As Integer, ZE As Integer, WE As Integer, K As Integer, LB As Integer
    
    WE = 48 'mit 0 beginnen 
    
    Application.ScreenUpdating = False
    Range("A3:T16").ClearContents 'reset 
    
    For ZE = 4 To 16
        For SP = 2 To 14
            Cells(ZE, SP) = Chr(WE)
            
            If Not IsNumeric(Chr(WE)) Then K = K + 1 'bei Buchstaben nur bis 4 
            If K = 4 Then 'nach 4 Buchstaben 
                M = 1
                LB = WE 'Letzer Buchstabe merken 
                WE = 47 'Zahlen einschieben 
                K = 0
            End If
            
            If WE = 57 Then 'Wenn bei 9 dann zu A 
                K = 0
                If M = 0 Then
                    WE = 65
                Else
                    WE = LB + 1
                End If
                
            ElseIf WE = 90 Then ' bei Z wieder neu beginnen 
                LB = 64
                WE = 48
            
            Else
                WE = WE + 1
            End If
        Next SP
    Next ZE

    'temporäres Blatt erzeugen 
    Sheets.Add after:=Sheets(Sheets.Count)
    With ActiveSheet
        .Range("A1:A26").FormulaR1C1 = "=RAND()+NOW()"
        .Range("B1:B26").FormulaR1C1 = "=CHAR(ROW()+64)"
        .Range("B1:B26").Value = .Range("B1:B26").Value
        .Sort.SortFields.Add Key:=Range("A1"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortTextAsNumbers
        With .Sort
            .SetRange Range("A1:B26")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        Sheets("Tabelle1").Range("B3:N3").Value = _
            WorksheetFunction.Transpose(.Range("B1:B16"))
        Sheets("Tabelle1").Range("A4:A16").Value = _
            .Range("B14:B26").Value
        
        With .Sort 'neu mischen 
            .SetRange Range("A1:B26")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        Sheets("Tabelle1").Range("P3:T3").Value = _
            WorksheetFunction.Transpose(.Range("B1:B5"))
        Sheets("Tabelle1").Range("O4:O16").Value = _
            .Range("B14:B26").Value
        
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
                
    End With
    With Range("P4:T16") ' Doppelte möglich 
        .FormulaR1C1 = "=RANDBETWEEN(10,99)"
        .Value = .Value
    End With
        
End Sub

LG UweD

Beliebteste Forumthreads (12 Monate)

	A	B	C	D	E	F	G	H	I	J	K	L	M	N
3		D	A	I	N	R	T	X	F	K	P	V	Z	G
4	C	0	1	2	3	4	5	6	7	8	9	A	B	C
5	J	D	0	1	2	3	4	5	6	7	8	9	E	F
6	O	G	H	0	1	2	3	4	5	6	7	8	9	I
7	S	J	K	L	0	1	2	3	4	5	6	7	8	9
8	M	M	N	O	P	0	1	2	3	4	5	6	7	8
9	H	9	Q	R	S	T	0	1	2	3	4	5	6	7
10	L	8	9	U	V	W	X	0	1	2	3	4	5	6
11	Q	7	8	9	Y	Z	0	1	2	3	4	5	6	7
12	U	8	9	A	B	C	D	0	1	2	3	4	5	6
13	W	7	8	9	E	F	G	H	0	1	2	3	4	5
14	E	6	7	8	9	I	J	K	L	0	1	2	3	4
15	B	5	6	7	8	9	M	N	O	P	0	1	2	3
16	Y	4	5	6	7	8	9	Q	R	S	T	0	1	2

	A	B	C	D	E	F	G	H	I	J	K	L	M	N
3		D	A	I	N	R	T	X	F	K	P	V	Z	G
4	C	0	1	2	3	4	5	6	7	8	9	A	B	C
5	J	D	0	1	2	3	4	5	6	7	8	9	E	F
6	O	G	H	0	1	2	3	4	5	6	7	8	9	I
7	S	J	K	L	0	1	2	3	4	5	6	7	8	9
8	M	M	N	O	P	0	1	2	3	4	5	6	7	8
9	H	9	Q	R	S	T	0	1	2	3	4	5	6	7
10	L	8	9	U	V	W	X	0	1	2	3	4	5	6
11	Q	7	8	9	Y	Z	0	1	2	3	4	5	6	7
12	U	8	9	A	B	C	D	0	1	2	3	4	5	6
13	W	7	8	9	E	F	G	H	0	1	2	3	4	5
14	E	6	7	8	9	I	J	K	L	0	1	2	3	4
15	B	5	6	7	8	9	M	N	O	P	0	1	2	3
16	Y	4	5	6	7	8	9	Q	R	S	T	0	1	2

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

	A	B	C	D	E	F	G	H	I	J	K	L	M	N
3		D	A	I	N	R	T	X	F	K	P	V	Z	G
4	C	0	1	2	3	4	5	6	7	8	9	A	B	C
5	J	D	0	1	2	3	4	5	6	7	8	9	E	F
6	O	G	H	0	1	2	3	4	5	6	7	8	9	I
7	S	J	K	L	0	1	2	3	4	5	6	7	8	9
8	M	M	N	O	P	0	1	2	3	4	5	6	7	8
9	H	9	Q	R	S	T	0	1	2	3	4	5	6	7
10	L	8	9	U	V	W	X	0	1	2	3	4	5	6
11	Q	7	8	9	Y	Z	0	1	2	3	4	5	6	7
12	U	8	9	A	B	C	D	0	1	2	3	4	5	6
13	W	7	8	9	E	F	G	H	0	1	2	3	4	5
14	E	6	7	8	9	I	J	K	L	0	1	2	3	4
15	B	5	6	7	8	9	M	N	O	P	0	1	2	3
16	Y	4	5	6	7	8	9	Q	R	S	T	0	1	2