10. juli 2006 - 11:59Der er
8 kommentarer og 2 løsninger
Bygge videre på VBA der vender en matrix..
Nedenstående kode var der en flink mand der hjalp mig med for lang tid siden i NG for regneark.
Koden tager en dataopstilling hvor der er tal ud til højre med en betegnelse over hver kolonne, f.eks. et budget med 12 månedskolonner, og omdanner det til en tabel med kun 1 kolonne med tal, men tilgengæld 12 linier for hver post (en for hver måned). Formålet er at få tabeldata der er mere fleksible at analysere med en pivottabel.
Makroen fungerer fint sålænge der kun er 1 kolonne og 1 række med navne.
Jeg kan ikke helt finde ud af at tilpasse makroen så den også kan håndtere hvis der f.eks. er to kolonner med "overskrifter" der skal "låses" ift. omdannelsen til en tabel - eller hvis der er 2 rækker med "overskrifter" der skal kopieres ned som en del af den nye tabel.
Er der nogen der kan hjælpe. Hvis makroen kan gøres dynamisk så brugeren definerer hvor mange hhv. kolonner og rækker der skal være "overskrifter" vil det være ekstra fornemt.
pft Thomas
Sub NuSkalDuVendes() Dim raDerSkalVendes As Range Dim startCelle As Range Dim iStartCol As Integer Dim iStartRow As Integer Dim Counter As Integer Dim myCell As Range
'Det aktuelle område ActiveCell kan udskiftes med Range("xx") Set raDerSkalVendes = ActiveCell.CurrentRegion iStartCol = raDerSkalVendes.Cells(1, 1).Column iStartRow = raDerSkalVendes.Cells(1, 1).Row 'Uden overskrifterne og første kolonne Set raDerSkalVendes = raDerSkalVendes.Offset(1, 1).Resize(raDerSkalVendes.Rows.Count - 1, raDerSkalVendes.Columns.Count - 1)
'Opretter lige et nyt ark til de vendte data ActiveWorkbook.Worksheets.Add Set startCelle = ActiveCell.Offset(1) 'Indsætter overskrifter ActiveCell.Value = "Overskrift A" ActiveCell.Offset(0, 1).Value = "Overskrift B" ActiveCell.Offset(0, 2).Value = "Overskrift C"
'Så løbes alle data igennem For Each myCell In raDerSkalVendes startCelle.Offset(Counter, 0).Value = myCell.Offset(0, -myCell.Cells.Column + iStartCol) startCelle.Offset(Counter, 1).Value = myCell.Value startCelle.Offset(Counter, 2).Value = myCell.Offset(-myCell.Cells.Row + iStartRow) Counter = Counter + 1 Next End Sub
De fleste virksomheder har efterhånden bevist, at AI virker.
Pilotprojekter leverer resultater. Medarbejdere bruger generative AI-værktøjer. Nye use cases dukker op på tværs af organisationen.
denne er til 2 kolonner og 2 rækkeoverskrifter. Den er desværre ikke dynamisk, men det fikser jeg måske engang (ellers klarer de andre nok det :-)))
Sub MatrixToList() Dim rngAll As Range Dim rngValues As Range Dim rngOutput As Range Dim c As Range Dim listen() Dim y As Long, x As Long
y = 0 Set rngAll = Application.InputBox(prompt:="hvilket område skal listes?", Type:=8) Set rngValues = rngAll.Offset(2, 2).Resize(rngAll.Rows.Count - 2, rngAll.Columns.Count - 2)
x = rngValues.Cells.Count ReDim listen(1 To x, 1 To 5) For Each c In rngValues If Not CSng(c) = 0 Then y = y + 1
udførVending End Sub Private Sub udførVending() Dim ræk, kol, målRæk, målKol ræk = antalOverRæk + 1 kol = 1
målRæk = antalRæk + 3 målKol = 1
For r = ræk To antalRæk For k = antalOverKol + 1 To antalKol For x = 1 To antalOverKol Cells(målRæk, målKol) = Cells(r, x).Value målKol = målKol + 1 Next x
Cells(målRæk, målKol) = Cells(r, k).Value målKol = målKol + 1 For y = 1 To antalOverRæk Cells(målRæk, målKol) = Cells(y, k).Value målKol = målKol + 1 Next y målKol = 1 målRæk = målRæk + 1 Next k Next r End Sub
Bak - det er kanon. Og hurtigt! Og så har det den yderligere fordel at jeg forstår tilstrækkeligt til at kunne tilpasse den manuelt. :o) Tak for det og smid et svar...
Supertekst - jeg har også prøvet dit bud. Jeg kan bare ikke få det til at virke? Det ser ud som om at der ikke sker noget når jeg aktiverer makroen. Jeg får ikke nogen fejlmeddelelser eller noget. Hvor er det meningen at den skal skrive resultatet til? Det er muligt at det er mig der er for træt til at fatte helt hvad jeg skal gøre. Men tak for indsatsen - smid et svar så fordeler jeg point.
Jeg opretter et nyt spørgsmål hvor jeg efterspørger en automatisering af din makro Bak - altså at man får mulighed for at indtaste hvor mange hhv. overskriftskolonner og rækker der er, og makroen så tilpasses til dette.. Det er tilladt ikke?
Nej - det er ikke nødvendigt - men det der måske er specielt, er at jeg beregner den sidste række i arket: "antalRæk = ActiveCell.SpecialCells(xlLastCell).Row" - hvis du prøver at erstatte denne linie med "nr. på din første ledige række" - så sker der måske noget:
Sådan ser mit test-resultat ud:
Art Afd jan feb mar apr maj jun År 1999 2000 2001 2002 2003 2004 Kto 1 B 1 2 3 4 5 6 Kto 2 C 11 22 33 44 55 66
Kto 1 B 1 jan 1999 Kto 1 B 2 feb 2000 Kto 1 B 3 mar 2001 Kto 1 B 4 apr 2002 Kto 1 B 5 maj 2003 Kto 1 B 6 jun 2004 Kto 2 C 11 jan 1999 Kto 2 C 22 feb 2000 Kto 2 C 33 mar 2001 Kto 2 C 44 apr 2002 Kto 2 C 55 maj 2003 Kto 2 C 66 jun 2004
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
