Makro för nybörjare

[johan011]

Hej !

 

Jag har precis gjort mitt första makro som jag nu skulle behöva lite hjälp med.

 

Makrot är otroligt enkelt och se ut som följer:

 

Range("D74").Select

Application.CutCopyMode = False

Selection.Cut

Range("E73").Select

ActiveSheet.Paste

Range("D75").Select

Selection.Cut

Range("F73").Select

ActiveSheet.Paste

Range("D76").Select

Selection.Cut

Range("G73").Select

ActiveSheet.Paste

Range("D77").Select

Selection.Cut

 

Som ni ser så tar markot ett värde ifrån en och samma kolumn och klistrar in det på samma rad som makrot började... Det kanske inte syns men det är i alla fall så den gör. Problemet som jag har är att jag skulle vilja att makrot börjar i den cellen som jag just då står i eller har markerat på annat sätt. Och sedan klistrar in värdet på den raden.

 

 

Problemet är att jag har ett dokument med massor med värden i en kolumn som jag måste få vågrätt dvs radvis istället för kolumnvis. Detta skulle kunna lösas väldigt enkelt om det inte var så att kolumnen med värden är indelad i flera mindre "sektioner" ( ex.. E1,E2,E3 ny sektion E5,E6,E7,E8,E9 - ny sektion - E11,E12 etc ) dessa sektioner skall sedan få varsin rad..

 

E1

E2

E3

skall bli

E1 D1 F1

 

Om någon har något tips på annan lösning än mitt makro så det varmt välkommet !

[CarlWan]

Om du vill transponera t.ex dina värden i E1, E2, E3 till E1, F1, G1 kan följande makro kanske hjälpa dig:

OBS! Aktiv cell måste vara E1 när du kör makrot!!

 

Sub Transponera()

ActiveCell.Offset(1, 0).Select

Selection.Cut

ActiveCell.Offset(-1, 1).Select

ActiveSheet.Paste

ActiveCell.Offset(2, -1).Select

Selection.Cut

ActiveCell.Offset(-2, 2).Select

ActiveSheet.Paste

End Sub

 

[johan011]

Perfekt det fungerar klockrent !!

 

tack !

 

Skulle det gå att få makrot att fortsätta tills den stöter på en tom cell eller en visst tecken.

 

Försökte också att få markrot att fortsätta längre än 3 rader men verkar göra något fel. Logiskt sett så borde det bli som följer :

 

Sub Transponera()

ActiveCell.Offset(1, 0).Select

Selection.Cut

ActiveCell.Offset(-1, 1).Select

ActiveSheet.Paste

ActiveCell.Offset(2, -1).Select

Selection.Cut

ActiveCell.Offset(-2, 2).Select

ActiveSheet.Paste

ActiveCell.Offset(3, -2).Select

Selection.Cut

ActiveCell.Offset(-3, 3).Select

ActiveSheet.Paste

End Sub

 

 

...eller ?

 

[inlägget ändrat 2002-11-06 10:56:06 av johan01]

[MH]

Testa med funktionen transponera istället (klistra in special). Lite trixigare, men betydligt flexiblare.

/m

Sub trakigt()
''lagrar adressen till "startcellen" 
   Dim StartCell As String
   StartCell = ActiveCell.Address

'markerar området som sträcker sig från 
'startcellen till nästa toma cell 
'(ctrl+ shift+ nerpil)
   ActiveCell.Select
   Range(Selection, Selection.End(xlDown)).Select

   Selection.Copy

''Klistrar in med hjälp av "transponera"
''En cell till höger om ursprungscellen 
''(eftersom transponera inte fungerar om 
''inklistringsområdet ligger i urklippsområdet)

   Range(StartCell).Select
   ActiveCell.Offset(0, 1).Select
   Selection.PasteSpecial Transpose:=True

''raderar ursprungsdata
   Range(StartCell).Select
   Range(Selection, Selection.End(xlDown)).Select
   Selection.ClearContents
'flyttar inklistrade data ett steg till vänster
   Range(StartCell).Select
   Selection.Delete Shift:=xlToLeft
End Sub

 

Ändring: la till lite kommentarer

[inlägget ändrat 2002-11-06 15:45:25 av MH]

[CarlWan]

MH

 

Mycket bra lösning väl värd flera poäng - kan dock bara ge en ;-)

 

Ifall det finns celler med innehåll på samma rad till höger om sista flyttningen, kommer dessa också att flyttas.

Range(StartCell).Select

Selection.Delete Shift:=xlToLeft

Jag skulle nog väja att ha följande kod för att undvika detta problem:

 

Range(StartCell).Select

ActiveCell.Offset(0, 1).Select

Range(Selection, Selection.En(xlToRight)).Select

Selection.Cut

Range(StartCell).Select

ActiveSheet.Paste

 

Vänligen

//Carl

 

[inlägget ändrat 2002-11-06 19:27:08 av CarlWan]

[johan011]

Yes, hurra !!

 

Precis exakt den funktionen som jag ville åt.

 

No more copy-paste !!!

 

 

Tusen tack för hjälpen !