lukuparien haku

iargjm

minkälaisella kaavalla taulukosta voisi hakea siinä useimmiten esiintyvät 2 lukuparia ja sitten seuraavaksi useimmiten esiintyvä jne? luvut on riveillä

7

703

Äänestä

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • varmaan hoituisi

      mutta lisätietoa tarvitaan. Missä etsittävät tiedot ovat ja mitä ne sisältää sekä minne esiintymiskerrat halutaan?

      • rthklrt

        tiedot on laskentataulukossa ja jokainen luku on omassa solussa, luvut on kokonaislukuja 1:stä alkaen. tieto voisi tulostua omaan taulukkoon taikka erilliseen ikkunaan kumpiko on helpompi toteuttaa. lukupareista ei välttämättä tarvitse löytää kuin esim. 5-10 useimmiten esiintyvää paria

      • rpo
        rthklrt kirjoitti:

        tiedot on laskentataulukossa ja jokainen luku on omassa solussa, luvut on kokonaislukuja 1:stä alkaen. tieto voisi tulostua omaan taulukkoon taikka erilliseen ikkunaan kumpiko on helpompi toteuttaa. lukupareista ei välttämättä tarvitse löytää kuin esim. 5-10 useimmiten esiintyvää paria

        Tässä esimerkissä toimitaan samassa taulussa (Taul1). Haettavat tiedot on A-sarakkeessa ja lukujen esiintymiskerrat tulevat C-D sarakkeisiin järjestettynä esiintymiskertojen mukaan.
        Kopioi koodi johonkin makromoduuliin esim. Module1. Huomaa, että taulun sarakkeiden C-D kaikki tiedot poistetaan ensiksi.

        Sub LaskeEsiintymisKerrat()
        Application.ScreenUpdating = False
        Sheets("Taul1").Activate
        Columns("C:D").ClearContents
        Set rng = Range(Cells(1, 1), Cells(1, 1).End(xlDown))
        rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("C1"), Unique:=True
        Lr = Range("C2").End(xlDown).Row
        Range("C1:C" & Lr).Sort Key1:=Range("C2"), Order1:=xlDescending, Header:=xlGuess

        For Each c In Range("C2:C" & Lr)
        Range("A1").AutoFilter Field:=1, Criteria1:=c.Value

        Kpl = Application.Subtotal(3, Range("A2:A65536"))
        Range("D" & c.Row) = Kpl
        Next

        Range("D1") = "Kerrat"
        ActiveSheet.AutoFilterMode = False
        Range("C1:D" & Lr).Sort Key1:=Range("D2"), Order1:=xlDescending, Key2:=Range("C2") _
        , Order2:=xlDescending, Header:=xlGuess

        End Sub

      • ervhevh
        rpo kirjoitti:

        Tässä esimerkissä toimitaan samassa taulussa (Taul1). Haettavat tiedot on A-sarakkeessa ja lukujen esiintymiskerrat tulevat C-D sarakkeisiin järjestettynä esiintymiskertojen mukaan.
        Kopioi koodi johonkin makromoduuliin esim. Module1. Huomaa, että taulun sarakkeiden C-D kaikki tiedot poistetaan ensiksi.

        Sub LaskeEsiintymisKerrat()
        Application.ScreenUpdating = False
        Sheets("Taul1").Activate
        Columns("C:D").ClearContents
        Set rng = Range(Cells(1, 1), Cells(1, 1).End(xlDown))
        rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("C1"), Unique:=True
        Lr = Range("C2").End(xlDown).Row
        Range("C1:C" & Lr).Sort Key1:=Range("C2"), Order1:=xlDescending, Header:=xlGuess

        For Each c In Range("C2:C" & Lr)
        Range("A1").AutoFilter Field:=1, Criteria1:=c.Value

        Kpl = Application.Subtotal(3, Range("A2:A65536"))
        Range("D" & c.Row) = Kpl
        Next

        Range("D1") = "Kerrat"
        ActiveSheet.AutoFilterMode = False
        Range("C1:D" & Lr).Sort Key1:=Range("D2"), Order1:=xlDescending, Key2:=Range("C2") _
        , Order2:=xlDescending, Header:=xlGuess

        End Sub

        tuota joo, tuo edellinen koodinpätkä ei ihan vastannut sitä jota hain. jos koitan selvittää lisää mitä ajan takaa. taulukon riveillä on esim. lukuja seuraavasti:
        2 15 20 46 55 74 78 80 81 93 150 200
        1 16 18 44 66 77 82 90 93 104 167 199
        2 4 12 20 55 44 69 75 80 81 99 167
        1 2 13 20 54 61 69 77 84 110 143 156

        eli tuosta noin puolihuolimattomasti laskien useimmiten esiintyvät parit 2 ja 20 esiintyy 3 kertaa, 20 ja 80 2 kertaa. eli haussa olisi kaksi lukua jotka useimmiten esiintyvät yhdessä kun tarkastellaan taulukkoa jossa nuo luvut ovat riveillä

      • ihmeessä
        ervhevh kirjoitti:

        tuota joo, tuo edellinen koodinpätkä ei ihan vastannut sitä jota hain. jos koitan selvittää lisää mitä ajan takaa. taulukon riveillä on esim. lukuja seuraavasti:
        2 15 20 46 55 74 78 80 81 93 150 200
        1 16 18 44 66 77 82 90 93 104 167 199
        2 4 12 20 55 44 69 75 80 81 99 167
        1 2 13 20 54 61 69 77 84 110 143 156

        eli tuosta noin puolihuolimattomasti laskien useimmiten esiintyvät parit 2 ja 20 esiintyy 3 kertaa, 20 ja 80 2 kertaa. eli haussa olisi kaksi lukua jotka useimmiten esiintyvät yhdessä kun tarkastellaan taulukkoa jossa nuo luvut ovat riveillä

        jokainen tieto pitää lypsää ? Mistä ihmeestä me voimme tietää mitä sinä oikein haluat ?
        Miten esim. 2 & 20 liittyvät yhteen tai miten 20 & 80 ????
        Sinä et kerro mitään ja odotat silti vastauksia...

      • kunde
        ervhevh kirjoitti:

        tuota joo, tuo edellinen koodinpätkä ei ihan vastannut sitä jota hain. jos koitan selvittää lisää mitä ajan takaa. taulukon riveillä on esim. lukuja seuraavasti:
        2 15 20 46 55 74 78 80 81 93 150 200
        1 16 18 44 66 77 82 90 93 104 167 199
        2 4 12 20 55 44 69 75 80 81 99 167
        1 2 13 20 54 61 69 77 84 110 143 156

        eli tuosta noin puolihuolimattomasti laskien useimmiten esiintyvät parit 2 ja 20 esiintyy 3 kertaa, 20 ja 80 2 kertaa. eli haussa olisi kaksi lukua jotka useimmiten esiintyvät yhdessä kun tarkastellaan taulukkoa jossa nuo luvut ovat riveillä

        collectionilla menee aika kivasti...
        muokkaa taulukot ja muut itsellesi sopivaksi

        HAUSKAA JOULUA JA HYVÄÄ UUTTA VUOTTA PALSTALAISILLE!!!
        Keep Excelling @Kunde

        Sub Haeparit()

        Dim Alue As Variant
        Dim Rivit As Long
        Dim Sarakkeet As Long
        Dim Parikokoelma As New Collection
        Dim Jäsen As Long
        Dim Kuvaus As String
        Dim Määrät(10000, 4) As String
        Dim i As Long
        Dim j As Long
        Dim k As Long
        Dim vika As Long
        On Error Resume Next

        Sheets("Taul1").Select ' muuta taulukon nimi
        vika = Range("A65536").End(xlUp).Row
        Alue = Range("A1:L" & vika) ' muuta alue

        Rivit = UBound(Alue, 1)
        Sarakkeet = UBound(Alue, 2)
        For i = 1 To Rivit
        For j = 1 To Sarakkeet - 1
        For k = j 1 To Sarakkeet
        If Alue(i, j) < Alue(i, k) Then
        Kuvaus = Alue(i, j) & "." & Alue(i, k)
        Else
        Kuvaus = Alue(i, k) & "." & Alue(i, j)
        End If
        Parikokoelma.Add Parikokoelma.Count 1, Kuvaus
        Jäsen = Parikokoelma(Kuvaus)
        If Määrät(Jäsen, 0) = "" Then
        Määrät(Jäsen, 0) = Kuvaus
        Määrät(Jäsen, 1) = Alue(i, j)
        Määrät(Jäsen, 2) = Alue(i, k)
        End If
        If Määrät(Jäsen, 3) = "" Then
        Määrät(Jäsen, 3) = "1"
        Else
        Määrät(Jäsen, 3) = CStr(CInt(Määrät(Jäsen, 3)) 1)
        End If
        Next k
        Next j
        Next i
        Sheets("Taul2").Select 'muuta taulukon nimi
        Cells.Clear
        Cells(1, 1).Resize(Parikokoelma.Count, 4) = Määrät
        Range("A1") = "Numero1.Numero2"
        Range("B1") = "Numero1"
        Range("C1") = "Numero2"
        Range("D1") = "Esiintymät"
        Range("A1:D1").Font.Bold = True
        Columns("A:D").Sort Key1:=Range("D2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        Columns("A:D").EntireColumn.AutoFit
        Columns("A:A").Delete 'poistaa Numero1.Numero2 sarakkeen
        End Sub

      • erferf
        kunde kirjoitti:

        collectionilla menee aika kivasti...
        muokkaa taulukot ja muut itsellesi sopivaksi

        HAUSKAA JOULUA JA HYVÄÄ UUTTA VUOTTA PALSTALAISILLE!!!
        Keep Excelling @Kunde

        Sub Haeparit()

        Dim Alue As Variant
        Dim Rivit As Long
        Dim Sarakkeet As Long
        Dim Parikokoelma As New Collection
        Dim Jäsen As Long
        Dim Kuvaus As String
        Dim Määrät(10000, 4) As String
        Dim i As Long
        Dim j As Long
        Dim k As Long
        Dim vika As Long
        On Error Resume Next

        Sheets("Taul1").Select ' muuta taulukon nimi
        vika = Range("A65536").End(xlUp).Row
        Alue = Range("A1:L" & vika) ' muuta alue

        Rivit = UBound(Alue, 1)
        Sarakkeet = UBound(Alue, 2)
        For i = 1 To Rivit
        For j = 1 To Sarakkeet - 1
        For k = j 1 To Sarakkeet
        If Alue(i, j) < Alue(i, k) Then
        Kuvaus = Alue(i, j) & "." & Alue(i, k)
        Else
        Kuvaus = Alue(i, k) & "." & Alue(i, j)
        End If
        Parikokoelma.Add Parikokoelma.Count 1, Kuvaus
        Jäsen = Parikokoelma(Kuvaus)
        If Määrät(Jäsen, 0) = "" Then
        Määrät(Jäsen, 0) = Kuvaus
        Määrät(Jäsen, 1) = Alue(i, j)
        Määrät(Jäsen, 2) = Alue(i, k)
        End If
        If Määrät(Jäsen, 3) = "" Then
        Määrät(Jäsen, 3) = "1"
        Else
        Määrät(Jäsen, 3) = CStr(CInt(Määrät(Jäsen, 3)) 1)
        End If
        Next k
        Next j
        Next i
        Sheets("Taul2").Select 'muuta taulukon nimi
        Cells.Clear
        Cells(1, 1).Resize(Parikokoelma.Count, 4) = Määrät
        Range("A1") = "Numero1.Numero2"
        Range("B1") = "Numero1"
        Range("C1") = "Numero2"
        Range("D1") = "Esiintymät"
        Range("A1:D1").Font.Bold = True
        Columns("A:D").Sort Key1:=Range("D2"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        Columns("A:D").EntireColumn.AutoFit
        Columns("A:A").Delete 'poistaa Numero1.Numero2 sarakkeen
        End Sub

        ne löytyi mukavasti, kiitoksia

    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Takaisin ylös

    Luetuimmat keskustelut

    1. Eduskunnan setämiehet eivät häiritse

      Porvariston sedät kertoivat kuorossa, että eivät tiedä häirinnästä mitään.
      Maailman menoa
      233
      6851

    2. Jaguar i pace sähköauto hajosi. Jopa 100 tonnia akun vaihto. Edullisia kilometrejä

      https://www.iltalehti.fi/autouutiset/a/fcaa5ae4-c04d-414d-ac54-dab991758b2e Tuo että sähköautossa ei lämmitys toimi on
      Hybridi- ja sähköautot
      30
      3506

    3. PropsApp Koodi

      Haluatko ansaita ja kilpailla fiksusti samalla kun seuraat urheilua? Props tekee sen mahdolliseksi. Sovelluksessa pääset
      Yleistä ohjelmista ja sovelluksista
      2
      3278

    4. Persut yrittävät epätoivon vimmalla

      kiertää häirintä asian https://www.iltalehti.fi/politiikka/a/5389f072-60d9-4ef8-aa7b-c11f0eda66cf jonka muut puolueet a
      Maailman menoa
      65
      3028

    5. Muistakaa demarit, että TE petitte, ei vihreät tai vas.liitto

      Te veitte eduskunnasta turvallisen tilan, veditte sen viemäristä alas. Te demarit, itsensä ylentäneet moraalinvartijat,
      Maailman menoa
      99
      2723

    6. Tämä on persut

      Persut kannattavat koko Suomen alueiden luovuttamista Venäjälle. Kannattavat myöskin väestönvaihtoa suomalaisten ja ven
      Maailman menoa
      5
      2623

    7. IL: "Kyykyttämistä, alistamista, painostamista, huutamista ja tiuskimista SDP:n

      eduskuntaryhmässä." Häirintäkohu puolueen ympärillä paisuu. Iltalehden haastattelemien SDP-lähteiden mukaan eduskunta-
      Maailman menoa
      35
      2338

    8. Riikka runnoo: konkursseja eniten 30 vuoteen

      Vuonna 2025 Suomessa haettiin konkurssiin yhteensä 3 906 yritystä. Konkurssiluku oli suurin sitten vuoden 1996.
      Maailman menoa
      38
      2104

    9. Oletko ollut

      Oletko omasta mielestäsi ollut sokea asioille?
      Ikävä
      54
      1841

    10. Pitäiskö meidän tehdä jotain

      Mennä vaikka kihloihin?
      Ikävä
      86
      1747
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt