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
IBM brugte mere end et år på at charmere sig til Watson-aftale med Region Hovedstaden: Her er første del af beretningen om, hvordan det højtprofilerede samarbejde kollapsede på blot 17 måneder
Watson-trilogien - kapitel 1 af 3: I kulissen knoklede IBM i månedsvis på at lande den nu kollapsede Watson-aftale med Region Hovedstaden. Charmeoffensiven bød blandt andet på en fremvisning af Watsons evner i New York for regionens topfolk. En række aktindsigter, som Computerworld har fået, afdækker forløbet.
CIO
Tech fra Toppen: Det har CIO Mads Madsbjerg Hansen fra FLSmidth lært af flere års global it-konsolidering
Tech fra Toppen: Flere års arbejde har betydet en reduktion i antallet af it-systemer hos FLSmidth. Men processen har ikke været uden overraskelser. Hør hvad CIO Mads Madsbjerg Hansen har lært af den omfattende og globale proces.
Job & Karriere
Toke Kruse: Jeg spår, at humankapital i 2019 erstattes af it-kapital
I 2019 vil vi se en kæmpe udskiftning af ressourcer, hvorunder de menneskelige processer overtages af software, der gør os mennesker hurtigere og mere effektive. Betyder det store fyringsrunder? Måske.
White paper
Kvartalsrapport på cyber-trusselslandskabet
I denne rapport dykker vi ned i cyber-trusselsbilledet for Q3. Vi har opsummeret statistikkerne fra millioner af trusselsforekomster observeret af Fortinet enheder i live produktionsmiljøer i hele verden. Ifølge IDC er Fortinet den mest adapterede netværks-sikkerhedsløsning, med 4,2 mio. implementerede devices. Det giver et unikt perspektiv på trusselslandskabet, som er destilleret ned i denne rapport. Download den her og få det fulde overblik.