Sub DoppelRoemTrenn()
Worksheets("Tabelle1").Activate
Dim rng As Range
Dim i As Integer
Dim r As Integer
Dim LastColumn As Long
Dim cell As Range
Set rng = Range(Cells(9, 12), Cells(9, 20))
LastColumn = Cells(9, Columns.Count).End(xlToLeft).Column
Cells(9, LastColumn).Activate
MsgBox Application.ActiveCell.Column
Dim Obergrenze As Long, Untergrenze As Long, x1 As Long, x2 As Long 'Zufallsgenerator für Füllung nach Doppelung
Dim BuchstabenArray As String
Dim Index As Variant
'Zelle für Füllung "Satzbeginn" bzw. z + 4 Zellen für "Satzende" auswählen
BuchstabenArray = ("G,g,H,h,I,i,I,j,K,k,L,l,M,m,O,o,P,p,Q,q,R,r,T,t,U,u") 'Tabelle 2 "Füllungen"
Index = Split(BuchstabenArray, ",")
Obergrenze = 26
Untergrenze = 1
x1 = Int((26 - 12 * Rnd) + 1) ' !! wählt zwischen 1 und 24
x2 = Int((6 - 2 * Rnd) + 1) ' ! wählt zwischen 1 und 6
Randomize
For i = 12 To 20 'i = Spaltennummern
If IsEmpty(Cells(9, i)) Then 'alle Zellen durchlaufen x2
Cells(9, i).Value = Index(x2 - 1)
End If
Next i
End Sub
|