Willekeurige naam uit 2 kolommen

[Ramsje]

Beste,

Momenteel ben ik bezig om een inschrijfformulier te maken.

De bedoeling is als volgt.

Ik heb 2 kolommen met namen. Deze wil ik in een andere cel (identiek van elkaar) willekeurig laten noteren (en laterna vast laten zetten, Dus een vba mogelijkheid is ook een optie)



Ik had zelf al een aantal formules geprobeerd, maar wanneer ik met 2 kolommen werkte, crashte de formule.

Met vriendelijke groet,

Ramzi

*Bijlage toegevoegd Bekijk bijlage Helpmij.xlsx

 

[Cobbe]

Post een Excel-bestand ipv een foto aub.

 

[Ramsje]

Best Cobbe,

Bijlage is toegevoegd aan het vorige bericht.

Met vriendelijke groet,

Ramzi

 

[HSV]

En dan???

Sub hsv()
Dim i As Long, j As Long, c00 As String, c01 As String
If Range("h4") = "" Then
For i = 1 To 4
  For j = 1 To 12
    c01 = Chr(Int(12 * Rnd()) + 65)
       If InStr(c00, c01) = 0 Then
         c00 = c00 & " " & c01
         Range("h4").Offset(i - 1) = Split(c00)(UBound(Split(c00)))
         Exit For
       End If
  Next j
Next i
End If
End Sub

 

[Cobbe]

Nu met echte namen:

Sub cobbe_hsv()
Dim i As Long, j As Long, c00 As String, c01 As String
Dim dic As Object
Range("h1:I12").ClearContents
On Error Resume Next
Set dic = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    For Each cl In Range("A2:A7,D2:D7")
        If Not dic.exists(cl.Value) Then dic.Add cl.Value, Nothing
    Next cl
 
        Range("I1:I50") = ""
        Range("I1").Resize(dic.Count).Value = Application.Transpose(dic.keys)

For i = 1 To 4
  For j = 1 To 12
    c01 = Cells(Int(12 * Rnd()), 9)
       If InStr(c00, c01) = 0 Then
         c00 = c00 & " " & c01
         Range("h4").Offset(i - 1) = Split(c00)(UBound(Split(c00)))
         Exit For
       End If
  Next j
Next i

End Sub

 

[HSV]

Zonder je hulpkolom.

Sub hsv()
Dim sq, i As Long, j As Long, c00 As String, c01 As String
sq = Split(Join(Application.Transpose(Blad1.Range("a2:a7"))) & " " & Join(Application.Transpose(Blad1.Range("d2:d7"))))
For i = 1 To 4
 For j = 0 To UBound(sq)
    c01 = sq(Int(11 * Rnd))
       If InStr(c00, c01) = 0 Then
         c00 = c00 & " " & c01
         Range("h4").Offset(i - 1) = Split(c00)(UBound(Split(c00)))
         Exit For
       End If
  Next j
Next i
End Sub

 

[Ramsje]

Dankjewel!

Is het misschien ook mogelijk om tussen naam 2 en 3 2 witregels te hebben?

Ik had namelijk een kleine opzet gemaakt zodat ik aan de hand van deze code het een en ander aan kan passen naar de juiste situatie, die iets complexer is. Maar van deze code snap ik niet heel veel dus zou ik willen vragen om na elke 2e naam 2 witregels te hebben. In dit geval tussen 2 en 3

B.v.d.

Ramzi

 

[HSV]

Gelieve een bestand te maken hoe het er wel uit moet komen te zien.
Iedereen (lees de meesten) denk(t)(en) maar een voorbeeldbestand te plaatsen en de codes even aan te passen, maar dit zijn codes die specifiek worden gemaakt.
Excel is leuk, maar het moet wel leuk blijven om het steeds maar aan te moeten passen.

 

[Ramsje]

Hierbij het nieuwe excel bestand.
Extra vraag. is het ook mogelijk om die code onzichtbaar te maken voor 3de?

 

[HSV]

Identiek blijven aan elkaar?

Sub hsv()
Dim sq, i As Long, j As Long, c00 As String, c01 As String
sq = Split(Join(Application.Transpose(Blad1.Range("a2:a7"))) & " " & Join(Application.Transpose(Blad1.Range("d2:d7"))))
For i = 1 To 4
 For j = 0 To UBound(sq)
    c01 = sq(Int(11 * Rnd))
       If InStr(c00, c01) = 0 Then
         c00 = c00 & " " & c01
         Range("g4").Offset(IIf(i < 3, i - 1, i + 3)) = Split(c00)(UBound(Split(c00)))
        Exit For
       End If
  Next j
Next i
End Sub

 

[Ramsje]

Dank u wel Harry,

Is het misschien mogelijk als u uitlegt waar (en hoe) de code zit op het punt dat die 4 witregels laat tussen de namen?
Ik vind het fijn als ik weet wat er staat. Zodat ik zoiets ook zelf kan doen de volgende keer etc.

Met vriendelijke groet,
Ramzi

 

[HSV]

Dat staat in dit stukje.

Range("g4").Offset(IIf(i < 3, i - 1, i + 3))

 

[MarcelBeug]

Nog een tip: voeg randomize toe aan de code, vóór: For i = 1 To 4
Anders krijg je telkens na het opnieuw openen van het bestand dezelfde reeksen "willekeurige" namen.

 

[HSV]

Niet aan gedacht Marcel. :thumb:

Sub hsv()
Dim sq, r, temp, rd, i As Long, j As Long
sq = Split(Join(Application.Transpose(Blad1.Range("a2:a7"))) & " " & Join(Application.Transpose(Blad1.Range("d2:d7"))))
  Randomize
  For i = 0 To UBound(sq)
     rd = Rnd()
        r = Int((UBound(sq) - i) * Rnd - rd + 1) + 1
        temp = sq(r)
        sq(r) = sq(i)
        sq(i) = temp
    Next i
    For i = 1 To 4
     Range("g4").Offset(IIf(i < 3, i - 1, i + 3)) = sq(i)
    Next i
End Sub