Peter Pind Juniormester
12. juli 2018 - 12:58 Der er 4 kommentarer og
3 løsninger

Sortere og flytte celler med tekst.

Jeg har et excel ark, som sortere hvilke numre der opstår i celle D flest gange, næst flest osv.
eksembel:

2545 (Opstår 50 gange)
2547 (Opstår 47 gange)
5485 (opstår 44 gange)
osv.

i data arket har nummeret 2545 i navn i celle E som jeg gerne vil have med i min graf. Kan man det?

Altså data arket har celle D med numre og celle E med navne.

min formel finder så det nummer der opstår flest gange i celle D og skriver det i celle F.
Nu vil jeg gerne have at navnet der passer til nummeret så kommer til at stå i celle G.

Håber det giver mening :)
excelent Ekspert
15. juli 2018 - 08:41 #1
http://excel.pm/Eksperten/TopTi.xlsm

Hent og gem filen på HD og kør den derfra
Peter Pind Juniormester
16. juli 2018 - 13:18 #2
Mange tak for din løsning. Har du et sted jeg kan se hvordan den er lavet så jeg kan ændre i den tl en anden gang? hvis jeg nu gerne vil have flere oplysninger med.
Celle D, E og F.
excelent Ekspert
17. juli 2018 - 08:59 #3
Du finder følgende VBA-kode ved at taste ALT+F11


Sub Kopier_Unikke()

'Opret midlertidig ark "Temp" hvis det ikke findes
If WorksheetFunction.IsErr(Evaluate("Temp" & "!A1")) = True Then
Sheets.Add: ActiveSheet.Name = "Temp"
End If
'Slet data fra sidste kørsel i Temp ark
Range("H2:J65000").Clear

Set sh1 = Sheets("Ark1") ' Ark hvor data er
Set sh2 = Sheets("Temp") ' Ark hvor resultat skrives

sh1.Select
Dim rng2 As New Collection
Dim rng As Range
rk = Cells(Rows.Count, "D").End(xlUp).Row
Set rng = sh1.Range("D2:D" & rk) ' ret range til aktuel

On Error Resume Next
For Each c In rng
  x = c & "#" & c.Offset(0, 1)
  rng2.Add x, CStr(x)
Next
On Error GoTo 0

sh2.Select
t = 1
For Each c In rng2
Cells(t + 1, "H") = Split(c, "#")(0)
  Cells(t + 1, "I") = Split(c, "#")(1)
t = t + 1
Next

Set rng2 = Nothing

'Tæl antal
rk2 = Cells(Rows.Count, "H").End(xlUp).Row
For Each c In Range("H2:H" & rk2)
c.Offset(0, 2) = Application.CountIf(rng, c)
Next

'Sorter
Range("H2:J" & rk2).Sort key1:=Range("J2"), Order1:=xlDescending

Set rng = Nothing

'Kopier 10 øverste til Ark1

Range("H2:J11").Copy sh1.Range("F2")
sh1.Select

End Sub
Peter Pind Juniormester
17. juli 2018 - 11:33 #4
Det skal jeg vidst lærer lidt mere om en dag - Youtube :)

Er det svært at tiljøje så den tager en celle mere med.

Altså at den sortere ligesom nu på celle D, men tager teksten med både i celle E og F,

Og så skriver den i G, H, I og J.
excelent Ekspert
17. juli 2018 - 13:08 #5
Nej det er forholdsvis simpelt. Udskift koden med denne :


Sub Kopier_Unikke()

'Opret midlertidig ark "Temp" hvis det ikke findes
If WorksheetFunction.IsErr(Evaluate("Temp" & "!A1")) = True Then
Sheets.Add: ActiveSheet.Name = "Temp"
End If
'Slet data fra sidste kørsel i Temp ark
Range("H2:K65000").Clear

Set sh1 = Sheets("Ark1") ' Ark hvor data er
Set sh2 = Sheets("Temp") ' Ark hvor resultat skrives

sh1.Select
Dim rng2 As New Collection
Dim rng As Range
rk = Cells(Rows.Count, "D").End(xlUp).Row
Set rng = sh1.Range("D2:D" & rk) ' ret range til aktuel

On Error Resume Next
For Each c In rng
  x = c & "#" & c.Offset(0, 1) & "#" & c.Offset(0, 2)
  rng2.Add x, CStr(x)
Next
On Error GoTo 0

sh2.Select
t = 1
For Each c In rng2
Cells(t + 1, "H") = Split(c, "#")(0)
  Cells(t + 1, "I") = Split(c, "#")(1)
  Cells(t + 1, "J") = Split(c, "#")(2)
t = t + 1
Next

Set rng2 = Nothing

'Tæl antal
rk2 = Cells(Rows.Count, "H").End(xlUp).Row
For Each c In Range("H2:H" & rk2)
c.Offset(0, 3) = Application.CountIf(rng, c)
Next

'Sorter
Range("H2:K" & rk2).Sort key1:=Range("K2"), Order1:=xlDescending

Set rng = Nothing

'Kopier 10 øverste til Ark1

Range("H2:K11").Copy sh1.Range("G2")
sh1.Select

End Sub
Peter Pind Juniormester
17. juli 2018 - 13:12 #6
Jeg siger mange tak :)
excelent Ekspert
17. juli 2018 - 13:24 #7
Velbekom :-)
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

Opret Preview

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





Premium
Globalconnect skifter navn efter fusion: Skal have ny identitet til nytår
Interview: Globalnet? Eller BroadConnect? GlobalConnect og og Broadnet har fusioneret, og det betyder, at det nye selskab skifter navn. Virksomheden skal også beslutte, om hovedkvarteret skal ligge i København eller Oslo.
CIO
Machine learning og kunstig intelligens med Jesper Steen Møller "Der er rigtigt meget teknik som for nogen ser nærmest magisk ud"
Tech fra Toppen: Hvornår det giver mening at bruge machine learning - og hvordan du kommer bedst muligt i gang? Få svaret i den seneste udgave af Computerworlds podcast "Tech fra toppen" med datalog Jesper Steen Møller.
Job & Karriere
Her er syv job-annoncer der overrasker med helt usædvanlige overskrifter
Der er mange ledige it-job i øjeblikket. It-jobbank har her fundet syv spændende stillinger, der har det til fælles, at annoncen har en utraditionel overskrift.
White paper
Den evigt forandrende rolle som it-manager – sådan ser fremtiden ud!
Rollen som it-manager har ændret sig meget, og bliver fremadrettet endnu vigtigere i enhver organisation, i takt med at teknologien udvikler sig. Det betyder at hverdagen er fyldt med mange udfordringer, som hele tiden stiller krav til medarbejderne og deres evne til at have de rette kompetencer. Hvad fremtiden bringer kan ingen spå om, men du får et bud på hvordan en it-managers hverdag ser ud i 2020, og hvilke løsninger der kan være vejen frem. Silotænkningen er fortid og det kræver at du som it-manager hele tiden tænker innovativt for at være på forkant. Hvordan du tilpasser dig til fremtiden, går vi i dybden med i dette Whitepaper.