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

Excel VBA - wyszukiwanie ilości wierszy zależnych od kilku warunków

dj_rey 04 Lut 2017 11:14 552 13
  • #1 04 Lut 2017 11:14
    dj_rey
    Poziom 4  

    Witam, byłbym wdzięczny za pomoc. Potrzebuję makro, które pomogło by w poniższym opisie.
    W Arkusz1 mam dane dotyczące kilku firm i teraz potrzebowałbym, aby zliczało mi ilość wierszy dla danej firmy do Arkusz2 z pominięciem tych, gdzie w kolumnie J jest "OK" i z podziałem na dane z kolumny A
    Przykład:
    Firma Firma_1 z kolumny C ma w totalu 19 wierszy
    6 wierszy z kodem 123 z kolumny A
    5 z kodem 235 z kolumny A - minus 1, gdyż jeden wiersz ma OK w kolumnie J czyli końcowy wynik wierszy to 4
    8 z kodem 450 z kolumny A - minus 4, gdyż jeden wiersz ma OK w kolumnie J czyli finalnie wierszy 5
    itd.
    Teraz aby ilości wierszy kopiowało do Arkusz2 (wpisałem tam ręcznie poprawne wyniki)
    Zaznaczyłem każdy podział firmy różnymi kolorami, aby ułatwić tłumaczenie.

    Dodatkowo jeśli jakaś firma z przypisanym kodem z kolumny A ma wszystkie wiersze zaznaczone OK, to aby usuwało ją automatycznie z listy w Arkusz2
    Przykład: Firma_3 z kodem 255 ma dwa wiersze, ale oba mają OK w kolumnie J, więc powinno je automatycznie usunąć z listy, a dane znajdujące się poniżej usuniętej firmy powinno automatycznie przesunąć jeden wiersz do góry
    OK w kolumnie J będzie przeze mnie dopisywane w zależności od potrzeb, więc po jakimś czasie lista w Arkusz2 powinna być pusta.

    0 13
  • Pomocny post
    #2 05 Lut 2017 13:38
    JRV
    Specjalista - VBA, Excel

    dj_rey napisał:
    firma z przypisanym kodem z kolumny A
    kod_2 nie ma znaczenia?

    Dodano po 43 [minuty]:

    Kod: vb
    Zaloguj się, aby zobaczyć kod

    0
  • #3 05 Lut 2017 14:55
    dj_rey
    Poziom 4  

    Dzięki, nie, kod_2 nie ma znaczenia
    Przydałoby się jeszcze obramowanie, które znikało by razem z kurczącą się listą w Arkusz2 :)

    0
  • Pomocny post
    #4 05 Lut 2017 15:30
    JRV
    Specjalista - VBA, Excel

    dodaj przed End Sub

    Kod: vb
    Zaloguj się, aby zobaczyć kod

    0
  • #5 05 Lut 2017 16:01
    dj_rey
    Poziom 4  

    Ok, dzięki :)

    0
  • #6 06 Lut 2017 19:23
    dj_rey
    Poziom 4  

    Jeszcze mam jedną prośbę, aby dodatkowo w kolumnie I od wiersza 2 wypisywało firmy, gdzie w Arkusz1 mają w całości zaznaczone OK w kolumnie J
    Przykład:
    w Arkusz1 Firma_2 ma trzy wiersze i jeśli przy każdym wierszu będzie w kolumnie J OK to wtedy wyświetla ją w Arkusz2 w komórce I2, przy kolejnej firmie będzie komórka I3 itd.

    0
  • #7 06 Lut 2017 20:17
    JRV
    Specjalista - VBA, Excel

    dj_rey napisał:
    wypisywało firmy
    niezaleznie od kod_1? np firma_1 jak bedzie 19 OK?

    0
  • #8 06 Lut 2017 20:29
    dj_rey
    Poziom 4  

    Tak zgadza się Firma_1 będzie miała 19, a kod_1 jest nieważny w tym przypadku

    0
  • #9 06 Lut 2017 21:27
    JRV
    Specjalista - VBA, Excel

    dodaj przed End Sub

    Kod: vb
    Zaloguj się, aby zobaczyć kod

    0
  • #10 06 Lut 2017 21:59
    dj_rey
    Poziom 4  

    W tej linii While bs(rs, 3) <> "" wyskakuje błąd Run-time error '1004': Application-defined or object-defined error

    0
  • #11 06 Lut 2017 22:06
    JRV
    Specjalista - VBA, Excel

    ten kod miel byc w koncu makro 'kokos', po

    Kod: vb
    Zaloguj się, aby zobaczyć kod

    0
  • #12 06 Lut 2017 22:11
    dj_rey
    Poziom 4  

    No tak wstawiłem i ten błąd w tej linii wyskakuje

    Code:
    Sub kokos()
    
    Dim bs As Range, bd As Range, bt As Range
    Dim rs&, re&, rd&
    Set bs = Sheets(1).Range("A:J").Cells
    Set bd = Sheets(2).Range("A:D").Cells
    re = bd(Rows.Count, 1).End(xlUp).Row + 1
    Range(bd.Rows(2), bd.Rows(re)).Delete
    bs.Sort key1:=bs(1, 3), key2:=bs(1, 1), Header:=xlYes
    rs = 2: re = 2: rd = 2
    While bs(rs, 1) <> ""
        If bs(rs, 1) <> bs(rs + 1, 1) Or bs(rs, 3) <> bs(rs + 1, 3) Then
            Set bt = Range(bs.Rows(re), bs.Rows(rs)).Cells
            If bt.Rows.Count <> Application.CountA(bt.Columns(10)) Then
                bd(rd, 1) = bt(1, 1): bd(rd, 2) = bt(1, 6): bd(rd, 3) = bt(1, 3)
                bd(rd, 4) = bt.Rows.Count - Application.CountA(bt.Columns(10))
                rd = rd + 1
            End If
            re = rs + 1
        End If
        rs = rs + 1
    Wend
    With Sheets(2).UsedRange
        For re = 7 To 12
            .Borders(re).Weight = xlThin
        Next
    End With
    rs = 2: re = 2: rd = 2
    While bs(rs, 3) <> ""
        If bs(rs, 3) <> bs(rs + 1, 3) Then
            Set bt = Range(bs.Rows(re), bs.Rows(rs)).Cells
            If bt.Rows.Count = Application.CountA(bt.Columns(10)) Then
                Sheets(2).Range("I" & rd) = bs(1, 3)
                rd = rd + 1
            End If
            re = rs + 1
        End If
        rs = rs = 1
    Wend
    End Sub

    0
  • Pomocny post
    #13 06 Lut 2017 22:15
    JRV
    Specjalista - VBA, Excel

    Aj.... literowka
    rs = rs = 1
    rs= rs+1 ma byc

    0
  • #14 06 Lut 2017 22:29
    dj_rey
    Poziom 4  

    ok, tyko, że kod kopiuje mi nazwę z komórki C1 (firma), a mi chodziło, aby kopiował nazwę firmy przy której wszędzie jest OK (Firma_1, Firma_2, ...) lub inaczej, jeśli jakaś firma Arkusz2 zniknie w całości z komórek A : D, to aby się pojawiła raz w kolumnie I

    0