< návrat zpět
MS Excel
Téma: Skrývání řádků pomocí makra na základě podmínky 
Zaslal/a littlebro 20.2.2017 11:42
Dobrý den,
prosím o radu - zlobí mi jedno makro a netuším, kde je chyba. Makro po spuštění vyhledá ve sloupci (mezi řádky 50 a 400) hledanou hodnotu (např. "254.420") a řádek s touto hodnotou poté skryje. To funguje v pořádku. Problém nastává, že se mi nedaří přinutit makro, aby prohledalo celý sešit, ne jen jeden list. Takhle je to neefektivní, protože na každém listu musím makro spustit znovu. Celý proces hledání se tváří, jakoby makro procházelo celý sešit, ovšem kromě prvního listu v těch dalších už řádky neskryje. Co je špatně?
Makro vypadá následovně:
Sub SkrytRadkyPodminkou_nove5()
Dim wSheet As Worksheet
For Each wSheet In ActiveWorkbook.Worksheets
For i = 400 To 50 Step -1
If StrComp("254.420", Cells(i, "A").Value) = 0 Then
Rows(i).Hidden = True
End If
Next i
For i = 400 To 50 Step -1
If StrComp("254.423", Cells(i, "A").Value) = 0 Then
Rows(i).Hidden = True
End If
Next i
For i = 400 To 50 Step -1
If StrComp("254.424", Cells(i, "A").Value) = 0 Then
Rows(i).Hidden = True
End If
Next i
Next wSheet
End Sub
Děkuji za rady.
AL(20.2.2017 12:35)#035020
Sub SkrytRadkyPodminkou_nove5()
Dim wSheet As Worksheet, i As Integer
For Each wSheet In ActiveWorkbook.Worksheets
With wSheet
For i = 400 To 50 Step -1
If StrComp("254.420", .Cells(i, "A").Value) = 0 Then
.Rows(i).Hidden = True
End If
Next i
For i = 400 To 50 Step -1
If StrComp("254.423", .Cells(i, "A").Value) = 0 Then
.Rows(i).Hidden = True
End If
Next i
For i = 400 To 50 Step -1
If StrComp("254.424", .Cells(i, "A").Value) = 0 Then
.Rows(i).Hidden = True
End If
Next i
End With
Next wSheet
End Subcitovat Stalker(20.2.2017 12:51)#035021 
?
Sub SkrytRadkyPodminkou_nove5()
Dim wSheet As Worksheet, i As Integer
For Each wSheet In ActiveWorkbook.Worksheets
With wSheet
For i = 400 To 50 Step -1
If .Cells(i, "A").Value Like "254.420" Or .Cells(i, "A").Value Like "254.423" Or .Cells(i, "A").Value Like "254.424" Then
.Rows(i).Hidden = True
End If
Next i
Next wSheet
End Sub
citovatlittlebro(20.2.2017 13:59)#035022 Á, tak tady byla chyba. Díky moc, vše funguje jak má ;-)
citovatelninoslov(20.2.2017 19:31)#035025 
Ak by tých riadkov a listov bolo veľa, tak by som to urobil cez pole a skrýval ich naraz. Napr. takto nejako. Je to Dynamicky nastaviteľné pomocou konštánt a poľa podmienok.
Sub Skryt_Riadky_Podmienene()
Dim Podmienka(), Riadok As Long, TMP As Integer, RNG As Range, aData(), WS As Worksheet
Const PRVY = 50
Const POSLEDNY = 400
Const STLP = 1
Podmienka = Array("254.420", "254.423", "254.424")
Application.ScreenUpdating = False
On Error Resume Next
For Each WS In Worksheets
With WS
aData = .Cells(PRVY, STLP).Resize(POSLEDNY - PRVY + 1).Value
For Riadok = 1 To POSLEDNY - PRVY + 1
TMP = WorksheetFunction.Match(CStr(aData(Riadok, 1)), Podmienka, 0)
If Err = 0 Then
If RNG Is Nothing Then Set RNG = .Cells(Riadok + PRVY - 1, STLP) Else Set RNG = Union(RNG, .Cells(Riadok + PRVY - 1, STLP))
Else
Err.Clear
End If
Next Riadok
If Not RNG Is Nothing Then RNG.EntireRow.Hidden = True: Set RNG = Nothing
End With
Next WS
Set WS = Nothing
Application.ScreenUpdating = True
End Subcitovat
RSS nejnovější články