Rijen verbergen

[bgerco]

Hallo,

Ik ben opzoek naar een macro die ik toevoegen aan een knop, waarbij in een bepaald worksheet (Gurbesoft) bij een druk op de knop alle rijen die de waarde '0' hebben in Kolom C verborgen worden . Bij alle andere waarden moeten de rijen wel zichtbaar zijn.

Kan iemand me helpen?

Mvg

Gerco van den Brink

 

[Finch]

Sub Verbegen()
Dim iRow As Integer
Const shtNaam = "Gurbesoft"

For iRow = 1 To Sheets(shtNaam).UsedRange.Rows.Count
    If Sheets(shtNaam).Cells(iRow, 3) = 0 Then
        Sheets(shtNaam).Rows(iRow).Hidden = True
    Else
        Sheets(shtNaam).Rows(iRow).Hidden = False
    End If
Next iRow

End Sub

 

[Wigi]

Afhankelijk van het aantal rijen dat je zo moet doen, gaat een Autofilter sneller tot veel sneller zijn. Als het slechts relatief weinig rijen zijn, bespaar je dan de extra moeite, anders kan het wel de moeite lonen.

 

[Ginger]

@Finch, Een klein tipje van mijn kant (heb ik óók pas terug geleerd)... Declareer een rij-nummer altijd als Long. Een Integer kan tot maximaal 32767, en dat zou in sommige gevallen wel 'ns tot een error kunnen leiden.

Groet, Leo

 

[Finch]

@Finch, Een klein tipje van mijn kant (heb ik óók pas terug geleerd)... Declareer een rij-nummer altijd als Long. Een Integer kan tot maximaal 32767, en dat zou in sommige gevallen wel 'ns tot een error kunnen leiden.

Groet, Leo

klopt inderdaad. Vroeger declareerde ik dat altijd als integer, maar idd ook als eens een foutmelding gehad, en sindsdien probeer ik dat altijd als long te definieren. Maar ik merk vaak nog als ik snel iets schrijf dat ik het vaak als integer declareer. Macht der gewoonte waarschijnlijk. Maar bedankt om er op te attenderen, ik ga er in het vervolg nog beter op letten.

 

[bgerco]

Heren,

Ik heb dit nou ingevuld onder mijn alreeds bestaande knop.

Dim iRow As Integer
Const shtNaam = "Gurbesoft"

For iRow = 1 To Sheets(shtNaam).UsedRange.Rows.Count
If Sheets(Gurbesoft).Cells(iRow, 3) = 0 Then
Sheets(Gurbesoft).Rows(iRow).Hidden = True
Else
Sheets(Gurbesoft).Rows(iRow).Hidden = False
End If
Next iRow

Hierna komt nog meer scripting en dus nog geen end sub eronder.

Ik krijg alleen een foutmelding dat het subscrips buiten het bereik valt. Ik heb het gedeelte dat geel wordt schuin neergezet. De code werkt dus nog niet.

Wie kan me verder helpen?

Groeten Gerco

 

[Wigi]

Moet je dit

Sheets(Gurbesoft)

niet veranderen door

Sheets(shtNaam)

 

[bgerco]

Klopt!

het werkt nu, maar nu nog 1 probleem..

Ik heb namelijk 1 knop die drie dingen doet. Namelijk,

alle rijen die in Rij C waarde 0 hebben verbergen
Dan dat blad opslaan als CSV waarde (komma gescheiden)
en dan alle zichtbare bladen afdrukken.

Deze hele scripting hoort er bij..

Private Sub CommandButton9_Click()
Dim iRow As Integer
Const shtNaam = "Gurbesoft"

For iRow = 1 To Sheets(shtNaam).UsedRange.Rows.Count
If Sheets(shtNaam).Cells(iRow, 3) = 0 Then
Sheets(shtNaam).Rows(iRow).Hidden = True
Else
Sheets(shtNaam).Rows(iRow).Hidden = False
End If
Next iRow

Dim objBereik As Object, DoelRij As Object, Cel As Object
Dim strTemp As String
Dim strDataNaam As String
Dim strKoppelteken As String
Dim strMapPad As String

strMapPad = "C:\" & Sheets("invulblad type 4").Range("D3").Value & ".csv"

strDataNaam = InputBox("Project klaar voor importeren in Gurbesoft? Zo ja, voer hieronder het projectnummer in.", "CSV-Export", strMapPad)
If strDataNaam = "" Then Exit Sub

strKoppelteken = InputBox(",", "CSV-Export", ",")
If strKoppelteken = "" Then Exit Sub

Set objBereik = Sheets("Gurbesoft").UsedRange

Open strDataNaam For Output As #1

For Each DoelRij In objBereik.Rows
For Each Cel In DoelRij.Cells
If Not IsEmpty(Cel.Value) Then
If InStr(1, Cel.Text, strKoppelteken) > 0 Then
'Cellen met splitsteken in rij zetten
strTemp = strTemp & """" & CStr(Cel.Text) & """" & strKoppelteken
Else
strTemp = strTemp & CStr(Cel.Text) & strKoppelteken
End If
End If
Next
If Right(strTemp, 1) = strKoppelteken Then strTemp = Left(strTemp, Len(strTemp) - 1)
If Not (strTemp = "") Then
Print #1, strTemp
strTemp = ""
End If
Next

Close #1
Set Bereik = Nothing
MsgBox "Data geexporteerd naar" & vbCrLf & strDataNaam


Dim blad As Worksheet
Application.ScreenUpdating = False
For Each blad In ActiveWorkbook.Worksheets
If blad.Visible = xlSheetVisible Then blad.PrintOut
Next blad
Application.ScreenUpdating = False

Het probleem nu is dat na het drukken op de knop ik inderdaad zie dat de rijen verborgen zijn, maar in het opgeslagen bestand zie ik nog wel deze rijen staan. met de 0 waarde, terwijl dit dus niet mocht. Op een of andere manier pakt hij het niet goed samen. Kan je me verder helpen?

groeten Gerco

 

[bgerco]

Mogelijk of niet mogelijk Wigi?

 

[Finch]

Ik heb de code niet in detail bekeken, maar denk dat je data in excel wil bijwerken naar een bepaalde layout, en vervolgens exporteren als CSV om in te laden in een ander programma. Het loopt mis bij het feit dat hij verborgen rijen in Excel toch overzet naar je CSV. Is dat correct?

Wat je dan kan doen is:
* de rijen niet verbergen maar verwijderen (deleten)
of
* de rijen die verborgen zijn niet exporteren naar de CSV file dmv van een controle hierop in te bouwen bij het wegschrijven naar de CSV file.

Aan u de keuze.

 

[bgerco]

De rijen mogen niet verwijderd worden, want kunnen later weer nodig zijn. Dus elke andere oplossing is welkom, zolang het eigenlijk maar mogelijk is met 1 druk op de knop.. Ik kan een hoop met excel, maar dit gaat mij boven de pet! Weet jij er wel 1 finch?

Groeten Gerco

 

[Rico9999]

Wordt een lastige macro.Mischien dat je eerst met conditional formatting ( voorwaardelijke opaak ) moet stellen dat alle lege cellen een bepaalde waarde krijgen, en daarna een macro maken die alle rijen dan verbergt.

Succes Rico

==========

Hallo,

Ik ben opzoek naar een macro die ik toevoegen aan een knop, waarbij in een bepaald worksheet (Gurbesoft) bij een druk op de knop alle rijen die de waarde '0' hebben in Kolom C verborgen worden . Bij alle andere waarden moeten de rijen wel zichtbaar zijn.

Kan iemand me helpen?

Mvg

Gerco van den Brink

 

[Finch]

De rijen mogen niet verwijderd worden, want kunnen later weer nodig zijn. Dus elke andere oplossing is welkom, zolang het eigenlijk maar mogelijk is met 1 druk op de knop.. Ik kan een hoop met excel, maar dit gaat mij boven de pet! Weet jij er wel 1 finch?

Groeten Gerco

optie 2 van mijn voorstel.

 

[bgerco]

En hoe kan ik die 2e optie inbrengen?

Snap hem namelijk niet 100%

 

[Finch]

Zonder te testen:

na deze twee lijnen code:

Open strDataNaam For Output As #1

For Each DoelRij In objBereik.Rows

if doelrij.hidden = false then          
    schrijf gegevens weg (for each cel...à
end if

 

[bgerco]

Wat moet er nu komen te staan op de plek van schrijf gegevens weg? (for each cell.. á)?

Anders kan ik het slecht testen..

 

[Finch]

de code die jij daar hebt staan. Het wegschrijven van je gegevens dien je gewoon te plaatsen binnen een if-then-else structuur.

Dus
if doelrij.hidde=false then
code die je hebt staan voor weg te schrijven
end if

 

[bgerco]

Helaas, ik heb het geprobeerd, maar het opgeslagen CSV bestand bevat nog steeds de cellen met een '0' waarde.

Hoe werkt de macro als ik ze bijvoorbeeld wel wil verwijderen?

 

[Finch]

Post je de code (tussen code tags) eens met de aanpassing die ik voorstelde?

 

[bgerco]

Private Sub CommandButton9_Click()


Dim objBereik As Object, DoelRij As Object, Cel As Object
Dim strTemp As String
Dim strDataNaam As String
Dim strKoppelteken As String
Dim strMapPad As String

strMapPad = "C:\" & Sheets("invulblad type 4").Range("D3").Value & ".csv"

strDataNaam = InputBox("Project klaar voor importeren in Gurbesoft? Zo ja, voer hieronder het projectnummer in.", "CSV-Export", strMapPad)
If strDataNaam = "" Then Exit Sub

strKoppelteken = InputBox(",", "CSV-Export", ",")
If strKoppelteken = "" Then Exit Sub

Set objBereik = Sheets("Gurbesoft").UsedRange

Open strDataNaam For Output As #1

For Each DoelRij In objBereik.Rows
If DoelRij.Hidden = False Then
Dim iRow As Integer
Const shtNaam = "Gurbesoft"

For iRow = 1 To Sheets(shtNaam).UsedRange.Rows.Count
    If Sheets(shtNaam).Cells(iRow, 3) = 0 Then
        Sheets(shtNaam).Rows(iRow).Hidden = True
    Else
        Sheets(shtNaam).Rows(iRow).Hidden = False
    End If
Next iRow
End If
For Each Cel In DoelRij.Cells
If Not IsEmpty(Cel.Value) Then
If InStr(1, Cel.Text, strKoppelteken) > 0 Then
'Cellen met splitsteken in rij zetten
strTemp = strTemp & """" & CStr(Cel.Text) & """" & strKoppelteken
Else
strTemp = strTemp & CStr(Cel.Text) & strKoppelteken
End If
End If
Next
If Right(strTemp, 1) = strKoppelteken Then strTemp = Left(strTemp, Len(strTemp) - 1)
If Not (strTemp = "") Then
Print #1, strTemp
strTemp = ""
End If
Next

Close #1
Set Bereik = Nothing
MsgBox "Data geexporteerd naar" & vbCrLf & strDataNaam


    Dim blad As Worksheet
    Application.ScreenUpdating = False
        For Each blad In ActiveWorkbook.Worksheets
            If blad.Visible = xlSheetVisible Then blad.PrintOut
        Next blad
    Application.ScreenUpdating = False


End Sub