Sub DoppelRoemTrenn()
Worksheets("Tabelle1").Activate
Dim cell As Excel.Range
Dim rng As Excel.Range
Dim i As Integer
Dim r As Integer
Dim LastColumn As Long
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
For i = 12 To 20 'i = Spaltennummern
Randomize
x1 = Int((26 - 12 + 1) * Rnd + 1) ' !! wählt zwischen 1 und 24
x2 = Int((6 - 1 + 1) * Rnd + 1) ' ! wählt zwischen 1 und 6
If IsEmpty(Cells(9, i)) Then 'alle Zellen durchlaufen x2
Cells(9, i).Value = Index(x2)
End If
Next i
End Sub
|