Avatar billede michaelrar Seniormester
26. november 2019 - 13:47 Der er 6 kommentarer og
2 løsninger

Finde huller i tal-intervaller

Hej alle

Nogen der kan hjælpe med en ikke alt for kompliceret VBA kode der kan finde "huller" i tal-intervaller.
Et lille eksempel:

67-101
500-690
11-444
705-1000

Her ønsker jeg så, at koden skal finde mindste tal ( 11 ) finde de intervaller der ikke er brugt ind til højeste tal nås. I dette tilfælde
445-499
691-704
Antallet af intervaller vil være vilkårligt, og kan i princippet variere fra 0 til mange :-).

Glæder mig til at se om nødden kan knækkes
Avatar billede bvirk Guru
26. november 2019 - 15:28 #1
Function inRanges()
    Dim serie, chosen As New Dictionary, min As Integer, max As Integer, i, prev
    min = 32767
    max = -32768
   
    For Each serie In Array( _
        Array(67, 101) _
        , Array(500, 690) _
        , Array(11, 444) _
        , Array(705, 1000))
        If serie(0) < min Then min = serie(0)
        If serie(1) > max Then max = serie(1)
        For i = serie(0) To serie(1)
            If Not chosen.Exists(Trim(str(i))) Then chosen.Add Trim(str(i)), ""
        Next
    Next
    prev = max
    For i = min To max
        If Not chosen.Exists(Trim(str(i))) Then
            If prev <> i - 1 Then
                'start on new serie
                If prev <> max Then
                    'close last - add new
                    inRanges = inRanges & prev & vbCrLf & str(i) & "-"
                Else
                    'fist not include
                    inRanges = str(i) & "-"
                End If
            End If
            prev = i
        End If
    Next
    inRanges = inRanges & prev
   
End Function
Avatar billede michaelrar Seniormester
26. november 2019 - 17:35 #2
Tæt på :-) , det spiller næsten :-)

Jeg har dog nok ikke lavet min beskrivelse helt perfekt :-(

Tallene står i 2 kolonner, f.eks. fra celle A1 til B4 som her

            A        B
1        67      101
2        500      690
3          11      444
4      705      1000

Når jeg ligger værdierne ind i et array her, får jeg kun et "hit"
Avatar billede bvirk Guru
26. november 2019 - 21:49 #3
Det var en sjov opgave - sådan kan man med andre ord beskrive det jeg fik ud af det oprindelige spørgsmål

67-101 er et interval af heltal, alså 67,68,69,... 101
500-690 er andet interval 500,501,502,...690

Foreningmængden af disse  mænger af heltal er tallene fra 67 til 690 med et 'hul' i serien fra 102 til 499.

Foreningsmængden givet af heltals serierne
67-101
500-690
11-444
705-1000

ses umiddelbart havende de 2 'huller' angivet i spørgsmålet

Princippet for at finde hullerne
1. sætte et flag for hver forekommende værdi, samtidig beregnede max og min værdi
2. gennemløbe fra min til max, identificerende grupper af ikke sat flag.

Tak for spørgsmålet, den slags er der alt for få af her på eksperten.
Avatar billede michaelrar Seniormester
27. november 2019 - 06:08 #4
Jeg skal nu bruge alle hittene, så i ovenstående eksempel (A1:B4) skulle jeg gerne have de 2 "huller" der er. Det giver din kode også. Jeg har "blot" brug for at finde talrækkerne i 2 kolonner og ikke i VBA-koden, og det er her det driller mig med at få tallene ind i et array som din kode vil læse :-)

Så denne talrække
          A        B
1        67      101
2        500      690
3          11      444
4      705      1000

Giver dette resultat
445-499
691-704
Håber det giver mening, og tusind tak, det er en stor hjælp :-)
Avatar billede bvirk Guru
27. november 2019 - 12:36 #5
Det var ikke skrevet i excel - det drillede også mig at loope rows min dette virker i excel 97

givet:

Sub push(V, i)
    If IsEmpty(V) Then V = Array()
    ReDim Preserve V(UBound(V) + 1)
    If IsObject(i) Then Set V(UBound(V)) = i Else V(UBound(V)) = i
End Sub

Function notInRanges(range)
    Dim serie, chosen As New Dictionary, min As Integer, max As Integer, i, prev, start
    min = &H7FFF
    max = -min
    For Each serie In range.Rows
        If serie.Cells(1) < min Then min = serie.Cells(1)
        If serie.Cells(2) > max Then max = serie.Cells(2)
        For i = serie.Cells(1) To serie.Cells(2)
            If Not chosen.Exists(i) Then chosen.Add i, ""
        Next
    Next
    prev = max
    For i = min To max
        If Not chosen.Exists(i) Then
            If prev <> i - 1 Then
                If prev <> max Then push notInRanges, Array(start, prev)
                start = i
            End If
            prev = i
        End If
    Next
    push notInRanges, Array(start, prev)
End Function


kan man udføre

Sub testnotInRanges()
    Dim notIns
    For Each notIns In notInRanges(range("a1:b4"))
        Debug.Print notIns(0) & "-" & notIns(1)
    Next
End Sub

------
i brugerudtryk vinduet :

testnotInRanges
Avatar billede michaelrar Seniormester
29. november 2019 - 15:32 #6
Tusind tak for hjælpen, så er det lige i skabet! :-)
Avatar billede bvirk Guru
29. november 2019 - 18:21 #7
Det var en fornøjelse - jeg tror dog der er en lille fejl- men test selv:

Hvis der ingen 'huller' er skal intet returnes eller noget bestemt returnes som passer med måden det bruges på:

Function notInRanges(range)
...
    Next
    If prev <> max then push notInRanges, Array(start, prev)
End Function
Avatar billede michaelrar Seniormester
30. november 2019 - 15:15 #8
Tak for det sidste hint også :-)
Jeg modificerer din kode lidt, så bliver det bare klasse 👍

Det skal bruges til, at finde "huller" i en tidsplan fra MS Project med +2500 linjer.

Bliver nok et lille juleferieprojekt, at få hele koden flettet sammen, så tak endnu engang :-)
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester