random(blande) funktion i excel

her er en makro til at blande de valget, NB de skal stå i en kolonne

Public Sub BlandValgte()
    Dim Valgte As Variant, Udvalgte() As Variant
    Dim I As Integer, R As Integer, Antal As Integer
    Randomize
    Valgte = Selection
    Antal = UBound(Valgte)
    ReDim Udvalgte(Antal)
    For I = 1 To Antal
        Do
            R = Int((Antal * Rnd) + 1)
            If Not IsEmpty(Valgte(R, 1)) Then
                Udvalgte(I - 1) = Valgte(R, 1)
                Valgte(R, 1) = Empty
                Exit Do
            End If
        Loop
    Next
    'næste linie skriver i C kolonnen, det er 3 tallet der bestemmer kolonnen
    Range(Cells(1, 3), Cells(Antal + 1, 3)) = Application.WorksheetFunction.Transpose(Udvalgte)
End Sub

her er den der tager det antal du ønsker ud fra alle

Public Sub BlandValgteAntal()
    Dim Valgte As Variant, Udvalgte() As Variant
    Dim I As Integer, R As Integer, Antal As Integer, Ud As Integer, OK As Integer
    Randomize
    Valgte = Range(Range("A1"), Range("A1").End(xlDown))
    Antal = Range(Range("A1"), Range("A1").End(xlDown)).Rows.Count
    Ud = InputBox("hvor mange skal vælges")
    OK = 0
    ReDim Udvalgte(Antal)
    For I = 1 To Antal
        Do
            R = Int((Antal * Rnd) + 1)
            If Not IsEmpty(Valgte(R, 1)) Then
                Udvalgte(I - 1) = Valgte(R, 1)
                Valgte(R, 1) = Empty
                OK = OK + 1
                Exit Do
            End If
        Loop
        If OK = Ud Then Exit For
    Next
    'næste linie skriver i C kolonnen, det er 3 tallet der bestemmer kolonnen
    Range(Cells(1, 3), Cells(Antal + 1, 3)) = Application.WorksheetFunction.Transpose(Udvalgte)
End Sub

tak for hjælpen, det er fandme smukt..

oprettede lige en ny makro, kaldte den RAndom, satte din kode ind og vupti, så blender den hvad jeg markerer og bruger makroen under tools.

Sig til hvis jeg har gjort noget forkert??
det er vist dine point

ok har ikke lige prøvet din anden version ...  Det må til senere
tak for hjælpen

lyder godt,
den første blander kun sammenhængende markering.
den anden tager det antal du vælger ud af alle navne

jeg har modificeret den første, nu kan den klare multiselect, flere ikke sammenhængende markerede.


Public Sub Bland()
    Dim Valgte() As Variant, Udvalgte() As Variant
    Dim I As Integer, R As Integer, Antal As Integer, A As Integer, L As Integer
    Randomize
    A = Selection.Cells.Count
    ReDim Valgte(A)
    L = 0
    For Each c In Selection.Cells
    Valgte(L) = c
    L = L + 1
    Next
      Antal = UBound(Valgte)
    ReDim Udvalgte(Antal)
    For I = 0 To Antal - 1
        Do
            R = Int((Antal * Rnd))
            If Not IsEmpty(Valgte(R)) Then
                Udvalgte(I) = Valgte(R)
                Valgte(R) = Empty
                Exit Do
            End If
        Loop
    Next
    'næste linie skriver i C kolonnen, det er 3 tallet der bestemmer kolonnen
    Range(Cells(1, 3), Cells(Antal + 1, 3)) = Application.WorksheetFunction.Transpose(Udvalgte)
End Sub

Et svar ;-))

kan ikke få nummer 2 til at virke, selvom det ville være fedt. har gjort som før men har nok lavet en fejl.

excel kokser bare og jeg bliver nødt til at lukke programmet.

kan ikke lige se hvordan jeg skal vælge antal navne

sorry. nr 2 virker fint.. Utroligt

findes der en måde hvorpå man kan sammenkoble kolonner, og stadig bibeholde metode to som du bekriver så flot. Eksemplet kunne være at kolonne A2 skal være låst med kolonne D2, og så og fremdeles.

på den måde kan man have noget tekst tilknyttet til feltet i A2 i D2, og det skulle helst være sådan at når man så blander følger informationen I cellen D2 med.

tak for eksperticen

I øjeblikket skriver den i C kolonnen, hvis den skal have det med i D kolonnen, hvor skal den så skrive det ??.

det bliver jo overskrevet, hvis det skal være der.

Har modificeret kabaks kode lidt
forudsætter du selecter i kolonne A, så rettes kolonne D med

Public Sub Bland()
    Dim Valgte() As Variant, Udvalgte() As Variant
    Dim I As Integer, R As Integer, Antal As Integer, A As Integer, L As Integer
    Dim adr(100), Valgte2(100), Udvalgte2(100)
    Randomize
    A = Selection.Cells.Count
    ReDim Valgte(A)
    L = 0
    For Each c In Selection.Cells
    Valgte(L) = c: adr(L) = c.Row: Valgte2(L) = c.Offset(0, 3)
    L = L + 1
    Next
      Antal = UBound(Valgte)
    ReDim Udvalgte(Antal)
    For I = 0 To Antal - 1
        Do
            R = Int((Antal * Rnd))
            If Not IsEmpty(Valgte(R)) Then
                Udvalgte(I) = Valgte(R): Udvalgte2(I) = Valgte2(R)
                Valgte(R) = Empty: Valgte2(R) = Empty
                Exit Do
            End If
        Loop
    Next
   
    For t = 0 To Antal - 1
    Cells(adr(t), 1) = Udvalgte(t): Cells(adr(t), 4) = Udvalgte2(t)
    Next
End Sub

tjaa mortenus så er det bare dig vi venter på !!!

dette er koden der virker som oprindeligt tænkt. godt gået, i er begge skrappe!!!
tak for hjælpen.

Du afslutter dine gamle spørgsmål ved at markere de navne som skal have point og klikke accepter.

ok har nu forsøgt at give point. håber det er ok.

nej det en ommer :-)
- flag er stadig gul

ok, skulle lige se scroll down menuen til venstre... takker