Elektroda.pl
Elektroda.pl
X
SterControl
Proszę, dodaj wyjątek www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

Napisałam takie makro VBA - pętla do while

moniqa90 22 Paź 2014 14:08 903 21
  • #1 22 Paź 2014 14:08
    moniqa90
    Poziom 7  

    Witam Was,

    napisałam takie makro:

    Sub copy()
    Dim r1 As Long, r2 As Long, r3 As Long, c1 As Long, licznik As Integer

    r1 = 2
    r2 = 1
    r3 = 12
    c1 = 1
    licznik = 1

    Worksheets("Sheet2").Activate
    Do While Cells(r1, c1) <> ""
    If Cells(r1, c1) <> Cells(r1, c1 + 1) Then
    Range(Cells(r2, c1), Cells(r2, 1)).copy
    Range(Cells(12 + licznik, 1), Cells(13 + licznik, 1)).Select
    ActiveSheet.Paste
    c2 = c2 + 1
    licznik = licznik + 4
    End If
    c1 = c1 + 1

    Loop

    End Sub

    i niestety nie działa prawidłowo

    Mam taki fragment excela

    A1 A2 A3 A4 A5 A6
    1293. 2750. 4324. 1294. 2750. 3765.
    B1 B2 B3 B4 B5 B6
    0. 0. 0. 1. 1. 1.

    Dodano po 1 [minuty]:

    A1.... i B1.... to są nazwy komórek, w których są umieszczone poszczególne liczby

    0 21
  • SterControl
  • #2 22 Paź 2014 14:13
    marcinj12
    Poziom 40  

    Co to znaczy, że nie działa prawidłowo? Makro uruchamia się i coś tam robi...

    0
  • #3 22 Paź 2014 14:22
    moniqa90
    Poziom 7  

    Więc tak, rzeczywiście się uruchamia ale robi nie do końca to co ja chcę. Ostatecznie chciałabym, że końcowy efekt wyglądał tak:
    L1 L2 L3
    1293. 2750. 4324.

    R1 R2 R3
    1294. 2750. 3765

    0
  • #4 22 Paź 2014 14:33
    marcinj12
    Poziom 40  

    Ech... Ale jaka ma być zasada tego "rozdzielenia"? I czemu pętlą while lecisz po kolumnach, skoro dane są w kolejnych wierszach?

    0
  • SterControl
  • #5 22 Paź 2014 14:49
    moniqa90
    Poziom 7  

    Ja to widzę tak:

    jeżeli wartości w komórkach w wierszu B są takie same to wtedy zaznacz (kopiuj) komórki z wiersza wyżej (jeżeli w wierszu B ilość komórek, które maja takie same wartości wynosi 3 - tak jak w tym wypadku to w wierszu wyżej ma zaznaczać dokładnie tą samą ilość komorek) - dlatego lecę po kolumnach.

    Następnie po kopiowaniu chciałam odpowiednio je wkleić. Czyli w tym wypadku po 3 komórki wklejać zaczynając od jakiejś tam komórki (w tej chwili to nieistotne) i wtedy sukcesywnie następne 3 komórki wkleić o 4 wiersze niżej niż poprzednie
    Mam nadzieję, że teraz jest to zrozumiałe

    Dodano po 9 [minuty]:

    Najchętniej to bym wrzuciła tutaj mój plik excela ale nie wiem czy można (a jeżeli tak to jak to zrobić)

    0
  • #6 22 Paź 2014 16:16
    JRV
    Specjalista - VBA, Excel

    Kliknij na 'Odpowiedz' lub 'Zmien'
    Kliknij na dole 'Dodaj załącznik (max. 50MB)' i Pokaż plik (xls). Jeśli xlsm, a następnie przed tym zapakuj go RAR lub zip

    0
  • #7 23 Paź 2014 08:22
    moniqa90
    Poziom 7  

    A więc dodaję swój plik Excela. W pliku mam na początku tylko dane takie jak w dwóch pierwszych wierszach a to co jest od wiersza 12 to jest to co chciałabym uzyskać.

    0
  • #8 23 Paź 2014 12:35
    moniqa90
    Poziom 7  

    widzę na pewno, że w moim makrze muszę poprawić to, żeby mi excel nie dopisywał do kolejnych wierszy wcześniej zaznaczonych komórek

    Dodano po 41 [minuty]:

    Albo myślałam o tym, żeby użyć delete, czyli jak już mi skopiuje to może łatwiej by było usunąć te wiersze których nie potrzebuje (tylko jak to zrobić, żeby usunął dokładnie te, na których mi zależy bez określania konkretnych komórek - chodzi o to, że ilość tych komórek do usunięcia może się zmienić).

    Dodano po 2 [godziny] 39 [minuty]:

    Teraz dodałam jeszcze cos takiego:

    Sub copy()
    Dim r1 As Long, r2 As Long, r3 As Long, c1 As Long, licznik As Integer

    r1 = 2
    r2 = 1
    r3 = 12
    c1 = 1
    licznik = 1

    Worksheets("Sheet2").Activate
    Do While Cells(r1, c1) <> ""
    If Cells(r1, c1) <> Cells(r1, c1 + 1) Then
    Range(Cells(r2, c1), Cells(r2, 1)).copy
    Range(Cells(12 + licznik, 1), Cells(12 + licznik, 1)).Select
    ActiveSheet.Paste
    c2 = c2 + 1
    licznik = licznik + 4
    End If
    c1 = c1 + 1

    Loop

    'Worksheets("Sheet2").Activate


    End Sub

    Sub licz()
    Dim LastCol As Integer, LastRow As Integer
    Dim j As Integer, i As Integer
    LastCol = Cells(13, Columns.Count).End(xlToLeft).Column
    'MsgBox LastCol
    LastRow = Range("A1").SpecialCells(xlCellTypeLastCell).row
    'MsgBox LastRow

    For i = 17 To LastRow Step 4
    j = 1

    Range(Cells(i, j), Cells(i, LastCol * j)).Select
    'Selection.Delete
    j = j + 1
    Next i
    End Sub

    Zmierzam w ogóle w dobrym kierunku?
    Ktoś może wie jak to poprawić?

    Dodano po 1 [minuty]:

    Różnie kombinuję, ale dalej efekt nie jest zadowalający. Proszę o pomoc

    0
  • #9 23 Paź 2014 14:07
    PRL
    Poziom 33  

    Cytat:
    Proszę o pomoc


    A ja poproszę o dane wejściowe i dane wyjściowe.

    Plik, który podesłałaś, to zakodowana inwokacja 'Pana Tadeusza'?

    0
  • #10 23 Paź 2014 14:22
    moniqa90
    Poziom 7  

    A co jest nie jasne w pliku?

    Napisałam przecież, że to co jest w dwóch pierwszych wierszach to są dane początkowe. A reszta to jest to co chciałabym uzyskać. Czyli chciałam uzyskać makro, które będzie kopiować po 3 komórki z wiersza pierwszego (akurat w tym wypadku) bo są trzy zera, trzy jedynki i ogólnie wszystkie liczby w drugim wierszu powtarzają się trzy razy.

    I później po skopiowaniu powklejać te trzy komórki w odpowiednim porządku (tak jak jest w pliku) -> czyli początkowo mam te dwa wiersze a po uruchomieniu makra chciałabym uzyskać taki efekt jaki widać po włączeniu pliku

    Dodano po 57 [sekundy]:

    Nie wiem jak mam to inaczej wytłumaczyć

    0
  • #11 23 Paź 2014 14:31
    PRL
    Poziom 33  

    Nie wiem, co kombinujesz.
    Może o to Ci chodzi?

    Kod: vb
    Zaloguj się, aby zobaczyć kod

    0
  • #12 23 Paź 2014 14:43
    moniqa90
    Poziom 7  

    PRL, dzięki za próbę pomocy, ale zdecydowanie to nie jest to na czym mi zależy

    Bardziej myślałam o tym, żeby uzależnić ilość kopiowanych komórek z pierwszego wiersza od ilości komórek w drugim wierszu, które mają te same wartości (dlatego, że ich ilość może się różnie zmieniać).

    W zasadzie to makro, które wkleiłam pierwsze prawie działa, dlatego raczej myślałam nad jego modyfikacją

    0
  • #13 23 Paź 2014 14:48
    PRL
    Poziom 33  

    Po prostu zamieść dwa zrzuty ekranu.
    Pierwszy z danymi wejściowymi, drugi z danymi, które będą po wykonaniu makra.

    P.S. Zwróć uwagę, że kilka osób próbuje Ci pomóc i nikt nie wie do końca 'co autor ma na myśli'.;)

    0
  • #14 23 Paź 2014 14:53
    moniqa90
    Poziom 7  

    Domyślam się że nie wiecie bo ja niestety nie potrafię w ogóle tłumaczyć. Zrobie jak radzisz :-)

    0
  • #17 23 Paź 2014 15:04
    moniqa90
    Poziom 7  

    widzę, że nie wstawiły się po kolei, więc tak

    dane wejściowe - bez tytułu
    po włączeniu makra - bez tytułu 1
    dla zobrazowania - bez tytułu 2

    0
  • #18 23 Paź 2014 16:06
    PRL
    Poziom 33  

    Kod: vb
    Zaloguj się, aby zobaczyć kod

    0
  • #19 23 Paź 2014 18:29
    JRV
    Specjalista - VBA, Excel

    moniqa90 napisał:
    Sub copy()
    Dim r1 As Long, r2 As Long, r3 As Long, c1 As Long, licznik As Integer

    Nie należy wywoływać swoich procedur (funkcje) słów zastrzeżonych.

    0
  • #20 24 Paź 2014 07:52
    moniqa90
    Poziom 7  

    PRL dzięki za pomoc, ale nie działa prawidłowo. Dzisiaj cos jeszcze pokombinuję

    0
  • #21 24 Paź 2014 09:39
    PRL
    Poziom 33  

    Rzeczywiście, źle napisałem kod.
    Tutaj działający:

    Kod: vb
    Zaloguj się, aby zobaczyć kod

    0
  • #22 24 Paź 2014 12:25
    moniqa90
    Poziom 7  

    dzięki wielkie, wszystko działa :-)

    0