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
Skrevet i går kl. 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
Skrevet i går kl. 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
Skrevet i går kl. 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
Skrevet i går kl. 13:12 #6
Jeg siger mange tak :)
excelent Ekspert
Skrevet i går kl. 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
Søren fik en god ide og overhalede Spotify inden om: Her er historien om skabelsen af verdens måske første gratis musiktjeneste - som var dansk
Fra Computerworlds arkiv: Søren Stig Tvilsted fik for knap 10 år siden idéen til TDC Play, der overhalede Spotify indenom og blev verdens første gratis musiktjeneste. "Folk var ved at dø af grin. De havde ganske enkelt aldrig hørt noget så tåbeligt før," fortæller han i dag. Her er historien om, hvordan TDC Play blev til.
Computerworld
Ny-opdaget malware blokerer programmer som forsøger at slette den: Særligt windows 10 er ramt
En ny type malware er blevet opfanget, der både overvåger din computer og generer falske reklameindtægter til bagmændende. Og så har den en forkærlighed for Windows 10.
CIO
Henrik Jeberg om at arbejde i Silicon Valley: "Er du dygtig nok får du tilbud der får en til at falde ned af stolen."
Henrik Jeberg bor i San Francisco og er direktør i Hampleton Partners, der rådgiver om opkøb med særligt fokus på teknologi. Hør ham fortælle om forskellen på Danmark og Silicon Valley - og om nogle af de vilde forhold der hersker i verdens ubestridte tech-hovedstad.
Job & Karriere
KMD opsagde tryghedsaftaler med medarbejderne få måneder før 300 medarbejdere blev outsourcet til IBM
KMD har i løbet af foråret opsagt to såkaldte tryghedsaftaler med en del af selskabets medarbejdere. Når aftalerne stopper ved udgangen af 2018, er de pågældende medarbejdere ikke længere berettiget til særlig godtgørelse. Det kan få konsekvenser, hvis IBM som forventet skærer i antallet af de 300 KMD-medarbejdere, som selskabet overtager.
White paper
Du slipper ikke … digitaliseringen rammer også dig og din virksomhed. Men gå ikke i panik, for de fundamentale færdigheder er (næsten) de samme som altid
Hvordan slipper industrivirksomheder i alle størrelser igennem det minefelt af markedskræfter, stadig mere krævende digitale kunder, konkurrencepres og digitale forventninger? Nøglen er at begynde med det fundamentale. Mennesker, smidige processer, digitalt lederskab og tilfredse kunder. Læs dette whitepaper fra Columbus med bidrag fra eksperter og få indsigt i relevant benchmarking. 24 sider på engelsk.