[excel VBA] powielanie wierszy wzgledem 2-go arkusza


(Tomekbe) #1

Na wstępnie witam szanownych ekspertów i osoby pomocne.

Potrzebuję pomocy (a tak naprawdę przydałby się gotowy kod) bo to wykracza poza moją obecną wiedzę... chodzi o sytuację gdy mam 2 arkusze - nazwijmy je 1 (ten gdzie mają być powielone wiersze) oraz 2 (ten w którym w jest kopia pierwszego i jest kolumna której jest tekst..także po przecinku jeśli więcej).

Przykład:

chciałbym by na podstawie pola w którym jest tekst np: "folia, worek, karton" kod w pierwszym arkuszu powielił dany wiersz na w sumie 3 pozycje i w każdej byłoby w tym polu już jedno słowo "folia", w drugim "worek" w trzecim "karton".. czyli z jednego wiersza zrobić trzy nie psując kolejnych wierszy i by automat przeszedł przez te kilkaset rekordów i to "ogarnął".. dodam, że pole o którym mowa będzie znormalizowane na potrzeby automatu (np: rozbicie na kolumny, brak spacji po przecinku, czy cokolwiek)..

Czy i jak jest to możliwe... a jeśli tak to serdecznie proszę o konkretną pomoc !..dodam, że strasznie mi się śpieszy :frowning:

Z góry serdecznie dziękuję za pomoc !


(Qoo) #2

To makro rozbija zawartość komórek z kolumny 1 w arkuszu "Arkusz1" do komórek kolumny 1 w "Arkusz2" i powiela wartości wiersza od kolumny 2 do 6. Cudo to to nie jest, ale kilka przeróbek i powinno się nadać.

Sub Makro()


Dim kom As String

Dim wiersze As Long

Dim wiersze2 As Long


    wiersze = ActiveSheet.UsedRange.Rows.Count

    wiersze2 = 1


    For i = 1 To wiersze

        kom = CStr(Cells(i, 1))


            Do While InStr(1, kom, ",") > 0

                Sheets("Arkusz2").Cells(wiersze2, 1) = Left(kom, InStr(1, kom, ",") - 1)

                kom = Right(kom, Len(kom) - InStr(1, kom, ","))

                Sheets("Arkusz1").Range(Cells(i, 2), Cells(i, 6)).Select

                Selection.Copy

                Worksheets("Arkusz2").Activate

                Cells(wiersze2, 2).Select

                ActiveSheet.Paste

                Worksheets("Arkusz1").Activate

                wiersze2 = wiersze2 + 1

            Loop


            If InStr(1, kom, ",") = 0 Then

                Sheets("Arkusz2").Cells(wiersze2, 1) = kom

                Sheets("Arkusz1").Range(Cells(i, 2), Cells(i, 6)).Select

                Selection.Copy

                Worksheets("Arkusz2").Activate

                Cells(wiersze2, 2).Select

                ActiveSheet.Paste

                Worksheets("Arkusz1").Activate

                wiersze2 = wiersze2 + 1

            End If


    Next i

End Sub

(Drobok) #3

Nie lepszy import danych ze względu na "," ?? Szybciej i nie wymaga znajomości vba ...


(Tomekbe) #4

Przepraszam za laickie pytania ale uważam się za amatora excela.. :

Ilość słów karton,worek,itp jest różna w różnych wierszach i są przypadki, że nic tam nie ma.. - makro może działać w zależności od np: ilości przecinków w komórce = ilość docelowa wierszy-1 skopiowanych ?

Import danych na podstawie "," - co mam przez to rozumieć ?? proszę o więcej informacji bo nie wiem o co chodzi... :frowning:

Mocno liczę na pomoc [-o<

Serdecznie dziękuję,

Tomasz Be


(Qoo) #5

Nie bardzo. Komórki zawierające tylko jedną wartość (np. karton) by wsiąkły.

Nie pisałeś, że mogą być puste komórki w tym zakresie. Co z takimi komórkami, powinny być pomijane? Jeśli tak to musisz uzupełnić If'a o dodatkowy warunek:

If InStr(1, kom, ",") = 0 And kom <> "" Then

Edit

A sorki, nie załapałem tego "-1"