GoldenLine
Zaloguj się
Krzysztof W.

Krzysztof W. profesjonalne cięcie
kosztów - zarabiamy
dla Ciebie

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Jako "mało używany" na tym forum (witam serdecznie) zapoznałem się pokornie ze spisem wątków i niektórymi zawartościami, ale nigdzie nie natrafiłem na coś przypominającego mi rozwiązanie mojego problemu... Towarzysze, pomożecie ? ;-)

Chodzi o to, żeby spowodować, że jeżeli wartość w jakiejś komórce (najlepiej zawartej w tym wierszu, ale niekoniecznie) wyniesie np. 1, cały wiersz ukrył się automatycznie.

Oczywiście można to to robić kolejno "na piechotę", ale jak się ma 200 wierszy, spośród których nigdy nie wiadomo, które trzeba będzie schować, sami rozumiecie...
Link do wypowiedziLink
Mariusz Jankowski

Mariusz Jankowski Programista
Excel/VBA

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Proponuję taki kod (jeżeli w wierszu znajduje się komórka z wartościa 1 wtedy makro ukrywa cały wiersz). Założenie jest tez takie, że dane muszą być zorganizowane w formie tabeli. Zamiast "Sheet1" trzeba podać nazwe arkusza z tabelą.



Sub UkryjWiersze()



Dim lWiersz As Long

Dim lKolumna As Long

Dim i As Long, j As Long



Application.ScreenUpdating = False



With ThisWorkbook.Worksheets("Sheet1")

lWiersz = .Cells(.Rows.Count, "A").End(xlUp).Row

lKolumna = .Cells(1, .Columns.Count).End(xlToLeft).Column



For i = 1 To lWiersz

    For j = 1 To lKolumna

        If .Cells(i, j).Value = 1 Then

            .Rows(i).Hidden = True

        End If

    Next j

Next i



End With



Application.ScreenUpdating = True



End Sub


PozdrawiamMariusz Jankowski edytował(a) ten post dnia 03.01.09 o godzinie 09:40
Link do wypowiedziLink
Janusz K.

Janusz K. Ekspert rozwoju i
przyszłości firm,
struktur, systemów
or...

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Kod wymaga oczywiście uruchomienia (można przypisać makro do przycisku)- a wtedy to makro wykona automatycznie swoją robotę.. ;-))
Link do wypowiedziLink
Krzysztof W.

Krzysztof W. profesjonalne cięcie
kosztów - zarabiamy
dla Ciebie

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Mariusz Jankowski:
Proponuję taki kod
Jestem pod dużym wrażeniem zarówno samej umiejętności znalezienia takiego mechanizmu, jak też szybkości rozwiązania problemu. Po obejrzeniu strony już się mniej dziwię... Jeśli nie ma Pan nic przeciwko temu, nawiążę kontakt na priv, bo niestety nie wyczerpuje to problemu (choćby z uwagi na zmienne nazwy plików). Niemniej, podziękować chcę "na ogóle" - co niniejszym czynię :-)
Link do wypowiedziLink
Mariusz Jankowski

Mariusz Jankowski Programista
Excel/VBA

Temat: automatyczne ukrywanie wierszy (lub kolumn)

W porządku - cieszę się, że mogłem pomóc.

Jeszcze taka korekta:

linię:
.Rows(i).Hidden

proponuję zamienić na:
.Rows(i).Hidden = True: Exit For

wtedy - gdy pętla znajdzie w wierszu komórkę z cyfrą 1 automatycznie ukryje wiersz i przejdzie do następnego wiersza - bez konieczności sprawdzania następnych danych w wierszu.

PS. I jeszcze drugi kod - makro nie sprawdza każdej komórki tylko cały wiersz :-)

Sub UkryjWiersze2()



Dim myRange As Range

Set myRange = ThisWorkbook.Sheets("Sheet1").Range("A1").CurrentRegion



Application.ScreenUpdating = False



For i = 1 To myRange.Rows.Count

    If Application.CountIf(Cells(i, "A").Resize(1, myRange.Columns.Count), 1) Then

        Cells(i, "A").EntireRow.Hidden = True

    End If

Next i



Application.ScreenUpdating = True



End Sub
Mariusz Jankowski edytował(a) ten post dnia 07.01.09 o godzinie 09:42
Link do wypowiedziLink
Patryk Kowalski

Patryk Kowalski ITIL process
manager/process
leader

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Witam serdecznie.
Wiem, że odgrzewam kotleta, ale niestety nie mogę nigdzie znaleźć rozwiązana.
Użyłem powyższego kodu i działa jak powinien, ale chciałem, żeby jeszcze odkrywał komórki, które nie spełniają parametru "1", a które wcześniej zostały ukryte.
Próbowałem wstawić

If .Cells(i, j).Value = "1" Then
.Rows(i).Hidden = True: Exit For
Else
.Rows(i).Hidden = False: Exit For
End If

ale niestety nie dział - proszę więc o pomoc
Link do wypowiedziLink
Michał Pawłowski

Michał Pawłowski Student, Szkoła
Główna Handlowa w
Warszawie

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Chciałbym Ci pomóc, ale nie bardzo rozumiem o co chodzi. Możesz dokładniej opisać cały swój problem?
Link do wypowiedziLink
Łukasz Mizgalski

Łukasz Mizgalski Process Manager |
Business Development
Manager | Project
...

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Witam koledzy, koleżanki...towarzysze broni o nazwie "Excel" ;)

Tym razem ja zwracam się do Was (uprzejmię zaznaczę...) o poradę, tudzież pomoc w zakresie VBA. "Mój" problem polega na filtrowaniu kolumn e excelu. DOkłądnie sytuacja wygląda następująco: W kolejnej kolumnie ale w jednym wierszu mam daty. Np. w 3 kolejnych kolumnach datę wczorajszą, w kolejnych 4 datę dzisiejszą itd. Kolumny z dataminie zaczynają się od kolumny "A", ale np. kolumny "H" i wiersz to np. wiersz "4". Wynik na którym mi zlaeży, to ukrycie kolumn z inną wartością daty niż ta zadana do filtracji i w komórce np. F82 policzenie il. niepustych komórek (dokładnie ilości komórek z datą podaną filtracji).

Mam nadzieję, że opisałem swoje "pragnienia" jakoś w miarę logicznie ;).

Z góry olbrzymie dzięki za pomoc!

pozdrawiam,
Łukasz
Link do wypowiedziLink

konto usunięte

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Witam

wiem, ze odgrzewam kotleta jeszcze bardziej, ale...

Siedze i proboje ale nic mi nie wychodzi, dlatego postanowilem poprosic o pomoc.

Jak kod VBA Pana Mariusza przerobic by:
a. Zamiast 1 ukrywał kolumny puste tj "" i zawierajace o
b. jezeli ukryta kolumna nie bedzie zawierala juz 0 badz "" to aby ona sie odkrywala ponownie - mam przypisaną formułe ktora raz daje jakas wartosc, a raz daje puste pole i chcialbym by wtedy byla ukrywana, a jak zwroci wartosc <> "" to by odkrywala sie ponownie.

Z gory dziekuje za pomoc
Pozdrawiam
Link do wypowiedziLink

konto usunięte

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Witam.
Nie wiem jaka jest struktura tabeli, ale może coś takiego :




Public Sub Ukryj_Odkryj()

Dim i As Long, lcolumn As Long

Dim ws As Worksheet

Dim kolumna As Range



Set ws = ThisWorkbook.Sheets(1)

lcolumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column



For i = 1 To lcolumn



Set kolumna = ws.Columns(i)



suma = Application.WorksheetFunction.Sum(kolumna)



If suma = 0 Then

kolumna.EntireColumn.Hidden = True

Else

kolumna.EntireColumn.Hidden = False

End If



Next i



End Sub

przypisz sobie do przycisku.

Przy założeniu, że w ostatniej kolumnie w pierwszym wierszu jest przynajmniej formuła.
Link do wypowiedziLink
Łukasz Kromski

Łukasz Kromski Regionalne Centrum
Krwiodawstwa i
Krwiolecznictwa w
Poznaniu

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Witam,
Jestem Tu nowy proszę więc o wyrozumiałość ;]
Potrzebowałbym kod na dynamiczne automatyczne ukrywanie i odkrywanie wierszy w zależności od spełnienia warunku.
Mam zestawienie umów i chciałbym, aby po przyciśnięciu przycisku lub najlepiej automatycznie wyświetlały się tylko te, które kończą się w okresie najbliższych 20 dni, a reszta była ukryta. Kolumna AA od komórki 3 w arkuszu podaje ilość dni do zakończenia umowy (wynik prostej reguły na datach), ale zawiera też określenie tekstowe NIE DOTYCZY dla pozycji które nie są objęte umową, co trzeba by było uwzględnić, że takie też maja być ukryte.

Całość w tej chwili bazuje na filtrach, ale chciałbym użytkownika odciążyć od klikania, żeby miał dynamiczny podgląd na kończące się umowy w zadanym zakresie czasowym.

Będę wdzięczny za pomoc.
Link do wypowiedziLink
Tomasz Szawan

Tomasz Szawan analityk finansowy

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Umieść to w ThisWorkBook i zmień ("Sheet1") na nazwę arkusza w twoim pliku gdzie masz dane.
Potestuj czy ukrywa daty z odpowiedniego zakresu. Jeśli nie to wyreguluj to tu "Date + 20".

Sub Workbook_Open()



    Dim Q As Integer

        For Q = 3 To Sheets("Sheet1").Range("AA3").CurrentRegion.Rows.Count

            If Sheets("Sheet1").Cells(Q, 27) = "NIE DOTYCZY" Or ActiveSheet.Cells(Q, 27) <= Date + 20 Then

                Sheets("Sheet1").Rows(Q).EntireRow.Hidden = True

            End If

        Next Q



End Sub
Link do wypowiedziLink
Jakub Kiendyś

Jakub Kiendyś Manager Management
Consulting

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Witam,

mam problem z pewnym Makro i chciałbym zapytać czy ktoś mógłby mi pomóc, mianowicie:

jak napisać makro, które w przypadku gdy w dowolnym wierszu, w kolumnie H znajduje się tekst “TAK”, to zostaną odkryte wszystkie bezpośrednio poniższe wiersze, które w kolumnie B zawierają tekst “podpowiedź”. I tak do wiersza, w którym ponownie w kolumnie H znajduje się wartość “TAK”. Wtedy ponownie powinno nastąpić odsłonięcie wierszy według powyższego schematu.

Z góry dziękuję za pomoc.

pozdrawiam!
Link do wypowiedziLink
Wojciech M.

Wojciech M. Senior Software
Engineer | Data
Science Team at
Analyx®

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Jakub K.:
Witam,

mam problem z pewnym Makro i chciałbym zapytać czy ktoś mógłby mi pomóc, mianowicie:

jak napisać makro, które w przypadku gdy w dowolnym wierszu, w kolumnie H znajduje się tekst “TAK”, to zostaną odkryte wszystkie bezpośrednio poniższe wiersze, które w kolumnie B zawierają tekst “podpowiedź”. I tak do wiersza, w którym ponownie w kolumnie H znajduje się wartość “TAK”. Wtedy ponownie powinno nastąpić odsłonięcie wierszy według powyższego schematu.

Z góry dziękuję za pomoc.

pozdrawiam!

Przyjąłem założenie, że wielkość liter nie ma znaczenia. Jeżeli ma mieć znaczenie, należy usunąć funkcje UCase oraz zapisać oba teksty w pożądany sposób.

Wariant I
Wszystkie podpowiedzi dla danego pytania powinny być jedna pod drugą, rozpoczynając od wiersza następującego po wierszu "TAK".

Sub OdkryjPodpowiedz()



    Dim columnH As Range

    Dim rowNumber As Long

    Dim cell As Range



    Application.ScreenUpdating = False



    With ActiveSheet

        Set columnH = Intersect(.UsedRange, Columns("H"))       

        For Each cell In columnH

            If UCase(cell.Value) = "TAK" Then

                rowNumber = cell.Row + 1

                Do While (UCase(.Cells(rowNumber, 2)) = "PODPOWIEDŹ")

                    .Rows(rowNumber).Hidden = False

                    rowNumber = rowNumber + 1

                Loop

            End If

        Next cell

    End With



    Application.ScreenUpdating = True



End Sub


Wariant II
Sprawdzane są wszystkie wiersze od następującego po "TAK" do poprzedzającego kolejne "TAK". Podpowiedzi dla danego pytania nie muszą być zatem jedna pod drugą, mogą dzielić je wiersze bez podpowiedzi.
Zakładam, że wiersze z podpowiedziami są ukryte, a nie odfiltrowane.

Sub OdkryjPodpowiedzV2()



    Dim columnH As Range

    Dim rowNumber As Long

    Dim cell As Range

    Dim lastCellRow As Long

    

    Application.ScreenUpdating = False



    With ActiveSheet

        lastCellRow = Columns("B").Find(What:="*", SearchDirection:=xlPrevious).Row

        Set columnH = Intersect(.UsedRange, Columns("H"))

        For Each cell In columnH

            If UCase(cell.Value) = "TAK" Then

                rowNumber = cell.Row + 1

                Do While (UCase(.Cells(rowNumber, 8)) <> "TAK" And rowNumber <= lastCellRow)

                    If UCase(.Cells(rowNumber, 2)) = "PODPOWIEDŹ" Then

                        .Rows(rowNumber).Hidden = False

                    End If

                    rowNumber = rowNumber + 1

                Loop

            End If

        Next cell

    End With



    Application.ScreenUpdating = True



End Sub

Pozdrawiam!Ten post został edytowany przez Autora dnia 02.12.13 o godzinie 23:55
Link do wypowiedziLink
Jakub Kiendyś

Jakub Kiendyś Manager Management
Consulting

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Witam Panie Wojtku,

bardzo dziękuję za szybką pomoc, to naprawdę budujące:)
Niestety po wklejeniu makra do mojego pliku nie nastąpiła akcja (może dlatego, że moje "tak" pochodzi z wybieranej listy).
Stworzyłem krótkie "dummy" w xls które obrazuje wcześniej opisany problem: https://www.wetransfer.com/downloads/5271dbfbac4a69263e...

albo:
http://we.tl/WJYIFbrXPN

We wczorajszym opisie zapomniałem wspomnieć, że aby wiersze z tekstem "Podpowiedź" w kolumnie B się odsłoniły to w bezpośrednio powyższych wierszach w kolumnie H znajduje się tekst "TAK" i dodatkowo w kolumnie B znajduje się tekst "Pytanie" (zobrazowałem sytuację w arkuszu 1 i tak wyjściowo wygląda moja tabela - czyli wszystkie wiersze są odsłonięte)
Czy makro mogłoby również automatycznie ukryć wszystkie wiersze, które w kolumnie B zawierają tekst "Pytanie" jeżeli bezpośrednio powyższy wiersz zawiera "Pytanie" w kolumnie B i nie zawiera "TAK" w kolumnie "H" (zobrazowałem sytuację w arkuszu 2).

Z góry dziękuję
Link do wypowiedziLink
Wojciech M.

Wojciech M. Senior Software
Engineer | Data
Science Team at
Analyx®

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Jakub K.:
We wczorajszym opisie zapomniałem wspomnieć, że aby wiersze z tekstem "Podpowiedź" w kolumnie B się odsłoniły to w bezpośrednio powyższych wierszach w kolumnie H znajduje się tekst "TAK" i dodatkowo w kolumnie B znajduje się tekst "Pytanie" (zobrazowałem sytuację w arkuszu 1 i tak wyjściowo wygląda moja tabela - czyli wszystkie wiersze są odsłonięte)
Czy makro mogłoby również automatycznie ukryć wszystkie wiersze, które w kolumnie B zawierają tekst "Pytanie" jeżeli bezpośrednio powyższy wiersz zawiera "Pytanie" w kolumnie B i nie zawiera "TAK" w kolumnie "H" (zobrazowałem sytuację w arkuszu 2).

Z góry dziękuję

Witam Panie Jakubie,

"Tak" może pochodzić z listy wybieranej.
Jeżeli wszystkie podpowiedzi byłyby ukryte, pierwsze makro odkryje w pierwszym arkuszu wiersze 2-6 i 8-10, a w drugim 2-6. Makro należy uruchomić mając aktywny arkusz, w którym chce się dokonać zmian.

Natomiast w kwestii ukrywania, poniżej przesyłam makro, jeżeli wszystkie wiersze są odkryte, makro ukryje wiersze 14-15 w pierwszym arkuszu oraz 8-10 i 13-14 w drugim.

Tak zrozumiałem Pana opis, jeżeli będzie potrzeba modyfikacji, proszę napisać, wprowadzenie ich będzie proste.

Pozdrawiam!
Sub UkryjPodpowiedz()



    Dim columnB As Range

    Dim rowNumber As Long

    Dim cell As Range



    Application.ScreenUpdating = False



    With ActiveSheet

        Set columnB = Intersect(.UsedRange, Columns("B"))

        For Each cell In columnB

            If UCase(cell.Value) = "PYTANIE" And UCase(.Cells(cell.Row, 8)) <> "TAK" Then

                rowNumber = cell.Row + 1

                Do While (UCase(.Cells(rowNumber, 2)) = "PODPOWIEDŹ")

                    .Rows(rowNumber).Hidden = True

                    rowNumber = rowNumber + 1

                Loop

            End If

        Next cell

    End With



    Application.ScreenUpdating = True



End Sub
Link do wypowiedziLink
Jakub Kiendyś

Jakub Kiendyś Manager Management
Consulting

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Witam Panie Wojtku,

udało się:) działa doskonale, wielkie dzięki!
Mam jeszcze 1 pytanko: co i gdzie musiałbym dopisać do obu makr aby automatycznie się uruchamiały w zależności od tego czy w wersie z tekstem "Pytanie" (kolumna B) w kolumnie H znajduje się "TAK" (wtedy zadziała makro "OdkryjPodpowiedz") lub coś innego (wtedy uruchamia się makro "UkryjPodpowiedz")

Bardzo dziękuję za pomoc:)
Link do wypowiedziLink
Wojciech M.

Wojciech M. Senior Software
Engineer | Data
Science Team at
Analyx®

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Jakub K.:
Witam Panie Wojtku,

udało się:) działa doskonale, wielkie dzięki!
Mam jeszcze 1 pytanko: co i gdzie musiałbym dopisać do obu makr aby automatycznie się uruchamiały w zależności od tego czy w wersie z tekstem "Pytanie" (kolumna B) w kolumnie H znajduje się "TAK" (wtedy zadziała makro "OdkryjPodpowiedz") lub coś innego (wtedy uruchamia się makro "UkryjPodpowiedz")

Bardzo dziękuję za pomoc:)

Panie Jakubie,

W takim razie proponuję poniższe rozwiązanie.
Proszę przekopiować oba makra i uruchomić tylko makro UkryjIOdkryjPodpowiedz_START, ponieważ to makro odwołuje się w trakcie pracy do makra AkcjaPodpowiedz.

W razie pytań proszę pisać.
Pozdrawiam!

Sub UkryjIOdkryjPodpowiedz_START()



    Dim columnB As Range

    Dim rowNumber As Long

    Dim cell As Range



    Application.ScreenUpdating = False



    With ActiveSheet

        Set columnB = Intersect(.UsedRange, Columns("B"))

        For Each cell In columnB

            If (UCase(cell.Value) = "PYTANIE") Then

                If (UCase(.Cells(cell.Row, 8)) <> "TAK") Then

                    AkcjaPodpowiedz ActiveSheet, rowNumber, cell, True

                Else

                    AkcjaPodpowiedz ActiveSheet, rowNumber, cell, False

                End If

            End If

        Next cell

    End With



    Application.ScreenUpdating = True



End Sub



Sub AkcjaPodpowiedz(sheet As Worksheet, rowNumber As Long, cell As Range, ifHide As Boolean)



    With sheet

        rowNumber = cell.Row + 1

        Do While (UCase(.Cells(rowNumber, 2)) = "PODPOWIEDŹ")

            .Rows(rowNumber).Hidden = ifHide

            rowNumber = rowNumber + 1

        Loop

    End With



End Sub
Link do wypowiedziLink
Jakub Kiendyś

Jakub Kiendyś Manager Management
Consulting

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Panie Michale,

jak zwykle dzięki za szybką reakcję i pomoc.
wszystko działa i mam nadzieję, że wkrótce mocniej się wgryzę w VB.
Praca idzie do przodu.

Oby więcej było tak życzliwych i pomocnych ludzi jak Pan.

pozdrawiam serdecznie i życzę miłego dnia!
Link do wypowiedziLink

konto usunięte

Temat: automatyczne ukrywanie wierszy (lub kolumn)

Witam,

podlacze sie do tematu.

Mam w komorce B7 mozliwosc wyboru TAK/NIE.
Jesli TAK to odkryj wiersze 10:19 i ukryj zawartosc komorek: D7:N7
Jesli NIE: to ukryj wiesze 10:19 i odkryj zawartosc komorek D7:N7.

Dodatkowo jesli w komorce B7 nie jest wybrana zadna opcja z dropdwon (TAK/NIE) to chcialbym zeby wiersze 10:19 byly ukryte, jak rownie zawartosci komorek: D7:N7

Rzezbe juz z godzine a efekty mizerne. Za wszelka pomoc bede dozgonnie wdzieczny.

Pozdrawiam
Bartek
Link do wypowiedziLink
« Wróć do tematów
Odpowiedz

Podobne tematy


Następna dyskusja:

Ukrywanie/odkrywanie kolumn




Wyślij zaproszenie do
Anuluj