OpenOffice.info

Code: Alles auswählen

Dim Sheet as Object

Sub Main
'welche tabelle? in dem Fall erste (0) für 2. Tabelle muss man 1 eingeben, usw.
Sheet = thisComponent.sheets(0)
'hier: werden die werte von A4 bis A11 zufaellig bei C4-C11 verteilt.
'und noch mal von b4-b11 bei d4-d11. Man kann auch mehrere functionen einfügen.
randValueFromRangeToRange("A4:A11", "C4:C11")
randValueFromRangeToRange("B4:B11", "D4:D11")
End Sub



Sub randValueFromRangeToRange(rangeFrom, rangeTo)
	Randomize
	CellRangeFrom = Sheet.getCellRangeByName(rangeFrom).RangeAddress
	CellRangeTo = Sheet.getCellRangeByName(rangeTo).RangeAddress

	Dim arrayFrom(CellRangeFrom.EndRow - CellRangeFrom.StartRow) as String
	Dim arrayTo(CellRangeTo.EndRow - CellRangeTo.StartRow) as String
	
	For i= CellRangeFrom.StartRow TO CellRangeFrom.EndRow
		arrayFrom(i-CellRangeFrom.StartRow)	= Sheet.getCellByPosition(CellRangeFrom.StartColumn, i).String
	Next i
	

	For ii = CellRangeTo.StartRow TO CellRangeTo.EndRow
		If Ubound(arrayFrom) = -1 Then Exit For
		
		index = Cint(Rnd*(Ubound(arrayFrom)))
		wert = arrayFrom(index)
		Sheet.getCellByPosition(CellRangeTo.StartColumn,ii).String = wert
		arrayFrom = DeleteFromArray(arrayFrom, wert)

	Next ii
	
End Sub

Function DeleteFromArray(ByVal array, wert)
	If Ubound(array) = -1 Then Exit Function
	Dim newArray()
	For Each elem IN array
		If elem <> wert Then
			elemsNow = Ubound(newArray)+1
			ReDim Preserve newArray(elemsNow)
			newArray(elemsNow) = elem
		EndIf
	Next elem

	DeleteFromArray = newArray
End Function