Antwort: Ja, es IST, "wäre" nicht nur...
30.10.2009 20:16:08
Erich
Hi Stefan,
nach meiner tollen ;-)) Antwort im Betreff hier der Code
(Die Fkt. Zufallsliste wird weiterhin gebraucht.):
Option Explicit
Sub Schlagw2()
' www.herber.de/forum/archiv/1112to1116/t1112904.htm
' Erich G. - 28.10.2009
Dim wks3 As Worksheet, lngZ As Long, zz As Long, lngN As Long, arrE() As String
Dim arrK, arrZ, pp As Long, strT As String
Dim lngK1 As Long, lngK2 As Long, lngN1 As Long, lngN2 As Long
Const SpKat As Long = 2 ' Spalte, in der max. 2 Tab3-Spalten-Nr. angegeben werden
' Trennzeichen ist "+", z. B. 4+1 für Spalten 4 und 1
Const SpSch As Long = 4 ' Spalte, in der die Schlagwörter abgelegt werden
Set wks3 = Worksheets("Tabelle3")
With Worksheets("Tabelle1")
lngZ = .Cells(.Rows.Count, SpKat).End(xlUp).Row
arrK = Application.Transpose(.Cells(SpKat, 2).Resize(lngZ - 1))
ReDim arrE(2 To lngZ)
For zz = 2 To lngZ
strT = arrK(zz - 1)
pp = InStr(strT, "+")
Select Case pp
Case 0, 1: lngK1 = Mid(strT, pp + 1): lngK2 = 0: lngN2 = 0
Case Len(strT): lngK1 = Left(strT, pp - 1): lngK2 = 0: lngN2 = 0
Case Else
lngK1 = Left(strT, pp - 1): lngK2 = Mid(strT, pp + 1)
lngN2 = wks3.Cells(wks3.Rows.Count, lngK2).End(xlUp).Row
End Select
lngN1 = wks3.Cells(wks3.Rows.Count, lngK1).End(xlUp).Row
arrZ = Zufallsliste(lngN1 + lngN2)
For lngN = 1 To 30
If lngN > 1 Then arrE(zz) = arrE(zz) & " "
arrE(zz) = arrE(zz) & wks3.Cells(arrZ(lngN) + lngN1 * (arrZ(lngN) > lngN1), _
-lngK1 * (arrZ(lngN) lngN1))
Next lngN
Next zz
.Cells(2, SpSch).Resize(lngZ - 1) = Application.Transpose(arrE)
End With
End Sub
In der Spalte mit den Kat-Nr. kannst du z. B. schreiben: 1 oder +3 oder 4+ oder 3+5 oder 2+2 oder...
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort