minkälaisella kaavalla taulukosta voisi hakea siinä useimmiten esiintyvät 2 lukuparia ja sitten seuraavaksi useimmiten esiintyvä jne? luvut on riveillä
lukuparien haku
iargjm
7734
0Äänestä
Muut lukivat myös
Odottaa vastausta
Näihin keskusteluihin ei ole vielä vastattu. Ole ensimmäinen.
Vastaukset 7
Vanhimmat
mutta lisätietoa tarvitaan. Missä etsittävät tiedot ovat ja mitä ne sisältää sekä minne esiintymiskerrat halutaan?
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
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...
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