tranponere flere rækker til en kolon

Du skal transponere en række af gangen. Marker de 5 celler i 1. række og transponer dem til en kolonne. Marker herefter de næste fem celler og transponer dem til samme kolonne, osv.
mvh
Erik Juul

tak.
Det er det jeg gør i øjeblikket. men det drejer sig om mange rækker og koloner. Og så tænkt jeg at man kunne gøre noget smartere med et eller andet formle.
banazmi

Nej det er sådan transponer fungerer. Hvorfor skal tallene placeres i en kolonne? Er det af hensyn til design eller beregninger?

Det med hensyn til beregning. I rækker er det timevis priser fra kl 01 til kl. 24 og i koloner er det datoer op til 3 månder. Jeg skal bruge værdierne i en kolon til bregningen.
mvh
banazmi

Det var det jeg tænkte.
Der er ikke noget i vejen for at lave beregninger selv om tallene står som de gør. SUM(A1:E3)lægger tallene sammen i dit eksempel ovenfor

Kolon hæmger sammen med en større regnskab, som har forskellige bergninger i koloner. Så talene skal være i en kolon. Kan man ikke brug et eller andet SQL-sætning til dette.
mvh
banamzi

Du kan prøve at køre denne makro:

Option Base 1

Sub list()
Dim rnga As Range
Dim rngb As Range
Dim rngc As Range
Dim c As Range
Dim listen()
Dim y As Long, x As Long

y = 0
Set rnga = Application.InputBox(prompt:="hvilket område skal listes?", Type:=8)
Set rngb = rnga.Offset(1, 1).Resize(rnga.Rows.Count - 1, rnga.Columns.Count - 1)
x = Application.WorksheetFunction.CountA(rngb)
ReDim listen(x, 1)
For Each c In rngb
  y = y + 1
  listen(y, 1) = c.Value
Next
Set rngc = Application.InputBox(prompt:="Hvortil ?", Type:=8)
rngc.Resize(x, 1) = listen
End Sub

bak>> du ved godt, at jeg får fnider over din kode :-)
Ovenstående har nok det problem at rnga bliver Resized til rngb og dermed mister øverste række. Det er fjernet i denne her.

Sub RangeToList()
    ' This make one or more ranges into a list in one column
    Dim rFrom As Range
    Dim rTo As Range
    Dim rCell As Range
    Dim vntValues() As Variant
    Dim sAnswer As String
    Dim lCells As Long
    Dim lCount As Long

    Set rFrom = Application.InputBox(Prompt:="Hvilket område skal listes?", Type:=8)
   
    lCells = rFrom.Cells.Count
    ReDim vntValues(lCells, 1)
   
    lCount = 0
    For Each rCell In rFrom
        lCount = lCount + 1
        vntValues(lCount, 1) = rCell.Value
    Next
   
    Set rTo = Application.InputBox(Prompt:="Øverste celle for listen?", Type:=8)
    rTo.Resize(lCells, 1) = vntValues
   
    ' Clean up
    Erase vntValues
    Set rFrom = Nothing
    Set rTo = Nothing
    Set rCell = Nothing
End Sub

Tak for Flemming :-), men den er bare hurtig ikke....
grunden til resize er at jeg har brugt koden til noget andet og ikke lige havde lyst til at fjerne det. Det eliminerer overskrifter og sideskrifter.
Den oprindelige kode var beregnet til at lave en matrix om til liste !

Ja, den kører dejlig hurtig - er lige ved at lege med et lille add-in, som kan køre både på den ene og anden led :-)

tak til bak og flemming.
på bak's løsning mister jeg både øveste række og de første kolon til venstre. altså de bliver ikke taget med.
Ve Flemming´s løsning sker der ingen ting, jeg får blank kolon.

På min mangler du nok første linie fra baks  Option Base 1

ellers skal den ændres til dette her:

Sub RangeToList()
    ' This make one or more ranges into a list in one column
    Dim rFrom As Range
    Dim rTo As Range
    Dim rCell As Range
    Dim vntValues() As Variant
    Dim sAnswer As String
    Dim lCells As Long
    Dim lCount As Long

    Set rFrom = Application.InputBox(Prompt:="Hvilket område skal listes?", Type:=8)

    lCells = rFrom.Cells.Count
    ReDim vntValues(1 To lCells, 1 To 1)

    lCount = 0
    For Each rCell In rFrom
        lCount = lCount + 1
        vntValues(lCount, 1) = rCell.Value
    Next

    Set rTo = Application.InputBox(Prompt:="Øverste celle for listen?", Type:=8)
    rTo.Resize(lCells, 1) = vntValues

    ' Clean up
    Erase vntValues
    Set rFrom = Nothing
    Set rTo = Nothing
    Set rCell = Nothing
End Sub

altså den første jeg sendte skal have Option Base 1 - det skal den anden IKKE - det er pga. denne linie ""ReDim vntValues(1 To lCells, 1 To 1)"" er ændret i nummer 2.

Det gik findt igennem. mange tak. jeg skal lige find ud af hvordan spørgsmålet lukkes og uddeling af point.
mvh
Banazmi

Du skal acceptere et svar - altså når du har fået et - ligesom dette her.
Points bør vel gives til bak for løsningen eller deles imellem bak og mig, så vent lige på et svar fra bak. Du kan nok lukke det i morgen.

ok. men tak for hjælpen og god nat.

Hvordan gemmer jeg makroen, så jeg kan brug den når jeg har behov for det.

Min makro er faktisk beregnet til at du markere overskrifter og kolonnen til venstre også inden du starter. Derved får du alle med.

banazmi>> når du gemmer din excel fil, så gemmes din makro med - ellers kan kodemodulet eksporteres indefra vba.

banazmi -> virker det eller skal du ha' mere hjælp ??

...eller skal vi ha lukket spørgsmålet ??

Undskyld til Bak og Flemmingdhal. Jeg har ikke haft muglighed for kunne svare før nu. Jeg ønsker at lukke spørgsmålet og fordele point ligeligt til jer begge to. Hvad skal jeg gør ?

begge løsninger virker.

Jeg tror der er noget der hedder Avanceret nede ved accept af svar, hvor du kan skrive points ud for hver person, som skal have nogle.

Tak til flemming og bak. Så er der 30 points til hver.