Przenoszenie danych z kilku kolum do jednej kolumny

ThomasX

unread,

Jun 25, 2009, 5:09:47 AM6/25/09

to

Witam

Mecze sie z napiasniem prostego makra, ktorego zadaniem będzie
przenoszenie danych z komorek znajdujacych sie w sasiednich kolumnach
jednego wiersza do jednej kolumy (np. w innym arkuszu). Czyli dane
powinny znajdowac sie pod soba.

ThomasX

unread,

Jun 25, 2009, 5:31:27 AM6/25/09

to

Zpomnialem dodac - mowie o VB w Excelu :)

Jacek

unread,

Jun 25, 2009, 8:16:10 AM6/25/09

to

Dnia Thu, 25 Jun 2009 02:31:27 -0700 (PDT), ThomasX napisaďż˝(a):

> Zpomnialem dodac - mowie o VB w Excelu :)

Zapusc petle i niech zrobi.
x=1
y=1
while sheets("a").cells(x,1)<>""
sheets("b").cells(y,1)=sheets("a").cells(x,1)
sheets("b").cells(y+1,1)=sheets("a").cells(x,2)
sheets("b").cells(y+2,1)=sheets("a").cells(x,3)
y=y+1
wend

cos w tym stylu.

Jacek

unread,

Jun 25, 2009, 8:18:52 AM6/25/09

to

y=y+3

Rafal Kwaczala

unread,

Jun 25, 2009, 12:44:12 PM6/25/09

to

Uzytkownik "ThomasX" <mat...@o2.pl> napisal w wiadomosci
news:d1f769ba-28ab-4086...@z34g2000vbl.googlegroups.com...

>
> Zpomnialem dodac - mowie o VB w Excelu :)
>

...a moze wystarczy zaznaczyc odpowiednie wiersze, Ctrl+C a nastepnie PPM,
opcja "Wklej specjalnie...", zaznaczyc "Transpozycja" i OK.

--
Pozdrawiam
Rafal Kwaczala

Jacek

unread,

Jun 25, 2009, 1:00:49 PM6/25/09

to

Troche nie tak, jak chcial autor, poza tym chcial w VBA.

ThomasX

unread,

Jun 25, 2009, 3:51:03 PM6/25/09

to

Transpozycja przez wklejanie specjalne odpada bo wierszy do
przeniesienia sa setki:) Pozostaje tutaj jedynie VBA.

Zastosowalem sie do Twojej wskazowki, ale nie dziala tak jak powinno.
Kolumna w Arkusz2 zapelniana jest trzema wierszami przeniesionymi z
trzech kolumn Arkusz1 do samego konca kolumny, az wyrzucany jest blad.
Zmienilem w kodzie na : x=x+1, ale wtedy pokazuje tylko wiersze
przeniesione z pierwszego wiersza Arkusz1 a chcialbym, aby pobieral w
ten sam sposob kolejne wiersze z Arkusz1 i wstawial do Arkusz2.
Ponizej kod, ktory stosowalem:

Sub kol()

Dim x, y As Integer

x = 1
y = 1

While Sheets("Arkusz1").Cells(x, 1).Value <> ""
Sheets("Arkusz2").Cells(y, 1) = Sheets("Arkusz1").Cells(x, 1)
Sheets("Arkusz2").Cells(y + 1, 1) = Sheets("Arkusz1").Cells(x, 2)
Sheets("Arkusz2").Cells(y + 2, 1) = Sheets("Arkusz1").Cells(x, 3)

x = x + 1
Wend

End Sub

Jacek

unread,

Jun 25, 2009, 10:07:50 PM6/25/09

to

Ja ci tylko nakreslilem sposob. To nie jest gotowiec...

Jacek

unread,

Jun 25, 2009, 10:12:56 PM6/25/09

to

To jest kod dzialajacy dla 3 kolumn:

Sub kol()
Dim x, y As Integer
x = 1
y = 1
While Sheets("Arkusz1").Cells(x, 1).Value <> ""
Sheets("Arkusz2").Cells(y, 1) = Sheets("Arkusz1").Cells(x, 1)
Sheets("Arkusz2").Cells(y + 1, 1) = Sheets("Arkusz1").Cells(x, 2)
Sheets("Arkusz2").Cells(y + 2, 1) = Sheets("Arkusz1").Cells(x, 3)
x = x + 1

y = y + 3
Wend
End Sub

Jacek

unread,

Jun 25, 2009, 10:24:32 PM6/25/09

to

No to masz gotowca:

Sub kol()
Dim x, y As Integer
x = 1

y = 0

While Sheets("Arkusz1").Cells(x, 1).Value <> ""

z = 1
While Sheets("Arkusz1").Cells(x, z) <> ""
Sheets("Arkusz2").Cells(y + z, 1) = Sheets("Arkusz1").Cells(x, z)
z = z + 1
Wend

x = x + 1

y = y + z - 1
Wend
End Sub

ThomasX

unread,

Jun 26, 2009, 2:38:48 AM6/26/09

to

teraz jest super :)

Wielkie Dziękuję!
... i pozdrowionka

Grzegorz Chomik

unread,

Jan 29, 2021, 5:18:12 AM1/29/21

to

A jak by to wyglądało jakbyśmy chcieli zachować np dane z pierwsej kolumny ?
mamy np w jednym wierszu w[pisanene że
Krzysiek pobrał piłke, wiadro i nożyczki
Adam pobrał konwke i szpadel

i chciałbym mieć w wyniku
Krzysiek piłke
Krzysiek wiadro
Krzysiek niżyczki
Adam konewkę
Adam szpadel

Ma nadzieję ze da się zrozumieć to co napisałem
dzięki

Grzegorz Chomik

unread,

Feb 10, 2021, 4:00:53 AM2/10/21

to

pytanie nieaktualne
poradziłem sobie z tym przy użyciu Power Query