Thema Datum  Von Nutzer Rating
Antwort
01.11.2016 22:23:23 kuddel
NotSolved
02.11.2016 13:44:57 BigBen
NotSolved
02.11.2016 21:17:00 Gast50319
NotSolved
03.11.2016 11:32:45 BigBen
NotSolved
Rot Zufallszuordnung Eigenschaften zu Elementen, jeweils lediglich 1mal
 03.11.2016 12:59:50 BigBen
NotSolved

Ansicht des Beitrags:
Von:
BigBen		 Datum:
03.11.2016 12:59:50		 Views:
703		 Rating:
     
Antwort:
  Ja
Thema:
Zufallszuordnung Eigenschaften zu Elementen, jeweils lediglich 1mal

Hallo,

habe mir nochmals Gedanken über eine Lösung gemacht.

Eventuell hilft diese Lösung weiter:

Sub FillAllocations()
    Dim shWork As Worksheet
    Dim rngFill As Range
    Dim rng As Range
    Set rngFill = Range("C2:C26")
    ' Bereich leeren
    rngFill.ClearContents
    ActiveSheet.Copy Before:=Sheets(1)
    Set shWork = Worksheets(1)
    
    For Each rng In rngFill.Cells
        rng.Value = "X" & CStr(rng.Row - 1) & " -> " & GetRandomize(shWork)
    Next
    Application.DisplayAlerts = False
    shWork.Delete
    Application.DisplayAlerts = True
End Sub

Function GetRandomize(shTMP As Worksheet) As String
    Dim rngPropList As Range
    Dim rngAllocList As Range
    Dim strProp As String
    Dim iRow As Integer
    Dim iMax As Integer
    Dim rng As Range
    ' In A1 und C1 steht der Titel
    If shTMP.Range("A3").Text <> "" Then
        iMax = shTMP.Range("A2").End(xlDown).Row
    Else
        iMax = 2
    End If
    Set rngPropList = shTMP.Range("A2:A" & CStr(iMax))
    Set rngAllocList = Range("C2:C26")
    Do
        iRow = Rnd() * rngPropList.Rows.Count
        strProp = Range("A" & CStr(iRow + 1))
        Set rng = rngAllocList.Find(strProp)
    Loop While Not rng Is Nothing
    rngPropList.Rows(iRow).Delete
    GetRandomize = strProp
End Function

Bei dieser Lösung wird eine Kopie vom Tabellenblatt angelegt und der eingetragene Eintrag aus der Tabelle gelöscht. Zum Schluss bleibt nur noch ein Eintrag übrig. Bei dieser Lösung dauert der Durchlauf nur wenige Sekunden. Am Ende wird die angelegte Tabelle wieder gelöscht.

LG, BigBen

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
01.11.2016 22:23:23 kuddel
NotSolved
02.11.2016 13:44:57 BigBen
NotSolved
02.11.2016 21:17:00 Gast50319
NotSolved
03.11.2016 11:32:45 BigBen
NotSolved
Rot Zufallszuordnung Eigenschaften zu Elementen, jeweils lediglich 1mal
 03.11.2016 12:59:50 BigBen
NotSolved