Excel - Makro tietojen siirtämiseksi riveistä sarakkeisiin

Ongelma

Tiedot ovat nyt alla olevassa muodossa

 1 2 3
9 15 16 20 25
1 

Tämän on tapahduttava tässä muodossa

 1
2
3
9
15
16
20
25
1 

Ratkaisu

oletukset:

• 1. Tiedot alkavat riviltä 1 ja kopioidaan aina sarakkeeseen A
• 2. Rivit voidaan lisätä ilman tietojen vääristymistä

 Sub TransposeSpecial ()
Dim lMaxRows yhtä pitkät max rivit arkissa
Dim lThisRow As Long -rivi käsitellään
Dim iMaxCol Kuten integer 'max käytetty sarake käsiteltävänä olevassa rivissä
lMaxRows = Solut (rivit.Luku, "A") Loppu (xlUp).
lThisRow = 1 'alkaa riviltä 1
Tee vaikka lThisRow <lMaxRows
iMaxCol = Solut (lThisRow, Columns.Count) .End (xlToLeft).
Jos (iMaxCol> 1) sitten
Rivit (lThisRow + 1 & ":" & lThisRow + iMaxCol - 1).
Alue (solut (lThisRow, 2), solut (lThisRow, iMaxCol)).
Alue ("A" & lThisRow + 1) .Valitse
Selection.PasteSpecial Paste: = xlPasteAll, Käyttö: = xlNone, SkipBlanks: = False, Transpose: = True
Alue (solut (lThisRow, 2), solut (lThisRow, iMaxCol)).
lThisRow = lThisRow + iMaxCol - 1
lMaxRows = Solut (rivit.Luku, "A") Loppu (xlUp).
Loppu Jos
lThisRow = lThisRow + 1
silmukka
Lopeta Sub 

Ota huomioon, että

Kiitos rizvisa1: stä tästä vinkistä foorumissa.