Kan man göra tvärtom?

[piam]

Hej!

 

Jag fick hjälp med en kod på det här forumet i förra veckan (av två vänliga själar som hette Johan och "Monshi"), som tog en hel kolumn och transponerade den till en tabell med valfritt antal kolumner. Nu slipper jag alltså sitta och kopiera och klistra och transponera rad efter rad som jag har behövt göra innan, så jag är jätteglad.

 

Nu undrar jag bara, går det att göra tvärtom också - göra om tabellen till en enda lång kolumn igen?

 

Jag försökte ändra lite i koden som jag hade fått, men "ActiveRow" som jag försökte med är tydligen inget tillåtet objekt och det är säkert en mängd andra fel jag har gjort. Jag har bara kodat enklare saker i VB, så det här är lite över-överkurs för mig!

 

Är det någon som har något tips på hur jag kan gå tillväga? Eller som vet någon bra sajt man kan lära sig dylikt på?

 

Jag har klistrat in båda originalkoden och den jag har försökt ändra i nedan.

 

Mvh,

 

Pia

 

------------------------------------------------------------------------

 

Originalkod á la Johan ft Monshi:

___________________________

 

[color="#0000ff"]Sub[/color] CreateColumnFromTable()

[color="#006400"]' Går igenom kolumnen för den för tillfället valda[/color]
[color="#006400"]' cellen och skapar en tabell med valfritt antal[/color]
[color="#006400"]' kolumner. Makrot fortsätter till första tomma[/color]
[color="#006400"]' cell i kolumnen. Den skapade tabellen startar i[/color]
[color="#006400"]' cellen angiven av intTableRow och intTableCol.[/color]

[color="#0000ff"]Dim[/color] intStep As Integer
[color="#0000ff"]Dim[/color] intTableRow As Integer
[color="#0000ff"]Dim[/color] intTableCol As Integer
[color="#0000ff"]Dim[/color] rnCell As Range

intStep = Val([color="#0000ff"]InputBox[/color]([GRÅ]"Antal kolumner i tabell: "[/GRÅ]))
intTableRow = -3
intTableCol = 3

[color="#0000ff"]While[/color] ActiveCell <> [GRÅ]""[/GRÅ]
[color="#0000ff"]Set[/color] rnCell = ActiveCell
Range(rnCell, rnCell.Offset(intStep - 1, 0)).Copy
Cells(intTableCol, intTableRow).PasteSpecial _
Paste:=xlPasteValues, Transpose:=[color="#0000ff"]True[/color]
intTableRow = intTableRow + 1
rnCell.Offset(intStep, 0).[color="#0000ff"]Select[/color]
[color="#0000ff"]Wend[/color]

[b]Application[/b].CutCopyMode = [color="#0000ff"]False[/color]

[color="#0000ff"]End[/color] [color="#0000ff"]Sub[/color]

--------------------------------------------------

 

Kod jag har ändrat i:

_________________

 

[color="#0000ff"]Sub[/color] CreateColumnFromTable()

[color="#0000ff"]Dim[/color] intStep As Integer
[color="#0000ff"]Dim[/color] intTableRow As Integer
[color="#0000ff"]Dim[/color] intTableCol As Integer
[color="#0000ff"]Dim[/color] rnRow As Range

intStep = Val([color="#0000ff"]InputBox[/color]([GRÅ]"Antal rader i kolumn: "[/GRÅ]))
intTableRow = -3
intTableCol = 3

[color="#0000ff"]While[/color] ActiveCell <> [GRÅ]""[/GRÅ]
[color="#0000ff"]Set[/color] rnRow = ActiveRow
Range(rnRow, rnRow.Offset(intStep - 1, 0)).Copy
Cells(intTableRow, intTableCol).PasteSpecial _
Paste:=xlPasteValues, Transpose:=[color="#0000ff"]True[/color]
intTableRow = intTableRow + 1
rnRow.Offset(0, intStep).[color="#0000ff"]Select[/color]
[color="#0000ff"]Wend[/color]

[b]Application[/b].CutCopyMode = [color="#0000ff"]False[/color]

[color="#0000ff"]End[/color] [color="#0000ff"]Sub[/color]

 

//snyggade till lite - KOD-taggar infogade. Ingen text ändrad //

-- Monshi - moderator VBA --

 

[inlägget ändrat 2005-05-23 11:08:28 av Monshi]

[Pejo]

Hej igen,

 

Har jag sagt A får jag väl säga B ...

 

Följande kod borde fungera:

 

[color="#0000ff"]Sub[/color] CreateTableFromColumn()

[color="#006400"]' Går igenom en tabell från den för tillfället valda[/color]
[color="#006400"]' cellen och skapar en enda vektor av alla rader.[/color]
[color="#006400"]' Makrot fortsätter till första tomma cell i[/color]
[color="#006400"]' tabellkolumnen. Den skapade vektorn startar i[/color]
[color="#006400"]' cellen angiven av intArrayRow och intArrayCol.[/color]

[color="#0000ff"]Dim[/color] intArrayRow As Integer
[color="#0000ff"]Dim[/color] intArrayCol As Integer
[color="#0000ff"]Dim[/color] rnCell As Range

intArrayRow = 1
intArrayCol = 1

[color="#0000ff"]While[/color] ActiveCell <> [GRÅ]""[/GRÅ]
    [color="#0000ff"]Set[/color] rnCell = ActiveCell
    Range(rnCell, rnCell.[color="#0000ff"]End[/color](xlToRight)).Copy
    Cells(intArrayRow, intArrayCol).PasteSpecial _
    Paste:=xlPasteValues, Transpose:=[color="#0000ff"]True[/color]
    intArrayRow = intArrayRow + Selection.Rows.Count
    rnCell.Offset(1, 0).[color="#0000ff"]Select[/color]
[color="#0000ff"]Wend[/color]

[b]Application[/b].CutCopyMode = [color="#0000ff"]False[/color]

[color="#0000ff"]End[/color] [color="#0000ff"]Sub[/color]

 

Raden

Range(rnCell, rnCell.End(xlToRight)).Copy

utgår från första kolumnen i tabellen och kopierar alla sammanhängande celler i raden (motsvarar Ctrl+Shift+högerpil) och fungerar inte om det finns tomma celler i raden. I så fall bytes raden ut mot någonting i stil med:

Range(rnCell, rnCell.Offset(0,intStep)).Copy

där intStep är ett fixt värde på antalet kolumner.

 

mvh

/Johan

 

 

//snyggade till lite - KOD-taggar infogade. Ingen text ändrad //

-- Monshi - moderator VBA --

 

 

[inlägget ändrat 2005-05-23 11:09:03 av Monshi]

[piam]

Hej igen!

 

Ja, B fungerade precis lika bra som A gjorde!

 

 

Tack återigen.

 

Vänliga hälsningar,

 

Pia