Random sampler

Hvad er formålet, hvis man må spørge?

Kan du vba ?

supertekst: Selvfølgelig må du det. Det skal bruges til at indsamle data og lave statistik på hvad tiden bliver brugt til i nogle specifikke afdelinger.

Finb: Lidt, men er ikke hardcore koder :)

Tak for Info
Hvor tit og hvormange pop-ops pr dag?

Jamen den skulle gerne komme med et pop-up hvert med et 15 minutters interval. Dvs. det er random hvornår indenfor de 15 minutter den popper up? Giver det mening

Prøv at komme med et eksempel på det ønskede forløb  i løbet af en dag - så der ikke er tvivl.

Tusinde tak fordi du vil hjælpe.

Det fedeste kunne være hvis man kunne fra gang til gang indstille den til hvor ofte den skulle pop-up, hvis dette ikke er muligt så 20 gange i timen - i tilfældig interval.

Så lad os sige jeg sidder ved computeren skal denne pop-up i gns. hver 3 minut.

I pop-up vinduet skal det så være muligt at skrive et tal fra 1-8 f.eks. eller 1-10 som så skal gemmes i arket. Så når dagen er gået har man alle data gemt i arket.

Håber det giver mere mening

Selv tak - synes også selv det lyder som en spændende udfordring.

Kommentarer:
"fra gang til gang"-indstilling
? Hvordan forestiller du dig dette

"1-8 eller 1-10"
? Opfattede det som valg af en defineret liste

"Gemt i arket"
? Hvor & hvad - oplysninger om den enkelte bruger?

? I hvilket tidsinterval skal det fungere - 08:00 - 16:00 eller ?

Det er jeg glad for at høre. Det overgår i hvert fald mine excel/vba kompetencer.

1. Eventuelt nogle felter hvor man kan indtaste antallet af pop-ups pr. time

2. Hvis man kan indtaste et tal i intervallet 1-10 er det rigtigt fint.

3. Den skal bare gemme det tal som bliver tastet i pop-up menuen. Og  næste gang man skriver i pop-up vinduet skal den så gemme det nye tal i rækken under det forrige.

4. Skal man bestemme det på forhånd? Den skal jo egentligt kunne virke 24 timer i døgnet da det er forskelligt hvilke tidspunker man skal bruge arket.

Giver det mere mening?

Det hjælper på det - dog lige et par bemærkninger:

1. "nogle felter" - i princippet kan man forestille sig 24 timer med hvert sit tal. Det er vel felter, der ikke skal være tilgængelige for brugeren.

4. Det er ok.

Hvor mange brugere skal anvende dette og hvad med indsamling af data?

1. Jeg tænker umiddelbart et felt hvor man kan indtaste antal pop-ups i timen. Dette kan eventuelt være et skjult ark med adgangskode (hvis dette er muligt).

Kun en bruger af gangen. Og indsamling af data er jo netop det som sker når personen indtaster et tal fra 1-10 som repræsenter nogle foruddefinerede kategorier (som ikke er i excel). Hvis du tænker på indsamling af data efterfølgende kan dette ske manuelt.

Ok..

Jeg skal lige høre om det drejer sig om Excel programmering eller et ganske almindeligt Excel regneark.

Jamen hvad end der kan fungere. Men umiddelbart ville det være svært at håndterer uden VBA - men hvis det er muligt er det kun godt.

Jeg bruger desværre ikke Excel, men jeg kan VBA.

Supertekst: Noget nyt i sagen? :)

Ja - er i gang med VBA-model.

Et spørgsmål: Skal Excel lukkes mellem de enkelte pop-ups - eller?

En minimering ville være mere end fint :)

Så når man havde udfyldt pop-up vinduet ville excel minimeres

Ok & tak

Det er skam mig der siger tak :)

Version 1 er klar - hvis du sender en mail - returnerer jeg filen.
@-adresse under min profil.

Den endelige version vil blive vist her.. ..

Const r20 = "4,1,5,7,1,2,1,3,6,1,2,3,1,2,4,8,3,2,3,1"
Dim tabel As Variant
Dim rXX() As Integer, pXX() As Boolean

Public antalPrTim As Integer                          'hentes fra ark Admin

Dim tast, tal As Integer
Dim aktuelleTim As Integer, antalTim As Integer, intervalMin As Integer
Dim okFlag As Boolean

Dim antalRækker As Integer, ræk As Integer

Dim storste As Integer, mindste As Integer, antal As Integer
Sub goON()
    Application.DisplayAlerts = False
    ActiveWorkbook.Application.WindowState = xlMaximized 'xlNormal
   
    okFlag = False
       
    antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
    If Range("A1") <> "" Then
        ræk = antalRækker + 1
    Else
        ræk = 1
    End If
   
    If antal = 0 Then
        opbygRandomTabel
        ActiveWorkbook.Application.WindowState = xlMinimized
        Application.OnTime (Now + TimeValue("00:" & Str(rXX(0)) & ":00")), "Module1.goON"
        antal = antal + 1
    Else
        Application.Windows("RandomSystem_2.xlsm").Activate
        indtastTal
    End If
   
End Sub
Private Sub indtastTal()
    While okFlag = False
        tast = InputBox("Tast et tal mellem 1-10", "Vælg kategori")
        If tast <> "" And IsNumeric(tast) = True Then
            tal = tast
            If tal > 0 And tal < 11 Then
                Range("A" & ræk) = tal
'                Range("B" & ræk) = Now              'tid
                ræk = ræk + 1

                ActiveWorkbook.Save
                ActiveWorkbook.Application.WindowState = xlMinimized
                Application.OnTime (Now + TimeValue("00:" & Str(rXX(antal)) & ":00")), "Module1.goON"
                antal = antal + 1
                okFlag = True
            Else
                fejlMelding
            End If
        Else
            fejlMelding
        End If
    Wend
   
    If antal = 20 Then
        antal = 0
'        Stop                                        'test
    End If
End Sub
Private Sub fejlMelding()
    MsgBox "Den indtastede værdi skal være mellem 1 - 10", vbOKOnly
End Sub
Private Sub opbygRandomTabel()
Dim flag As Boolean, pladsNr As Integer, x As Integer
    ReDim rXX(antalPrTim)
    ReDim pXX(antalPrTim)
   
    tabel = Split(r20, ",")                        'evt. test af antal pr. tim - p.t. kun 20 x
    antal = 0
    flag = False

    storste = UBound(tabel)
    mindste = 0
   
    For x = 1 To antalPrTim
        While flag = False
            Randomize
            pladsNr = Int((Rnd() * (storste - mindste + 1) + mindste))
            If pXX(pladsNr) = False Then
                pXX(pladsNr) = True
                flag = True
                rXX(antal) = tabel(pladsNr)
                antal = antal + 1
            Else
                If antal < 20 Then
                    flag = False
                End If
            End If
        Wend
        flag = False
    Next x
    antal = 0
   
   
Rem Test - vis
'    For x = 0 To 19
'        Range("C1").Offset(0, x) = rXX(x)
'    Next x
End Sub

Mange tak supertekst for et kanon stykke arbejde :)

Vh. Ruben