• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Zoeken en verbergen

Status
Niet open voor verdere reacties.

jammi

Gebruiker
Lid geworden
30 mrt 2010
Berichten
62
Beste,

Ik heb een file waar ik in verschillende tabellen zoek, indien er een lege waarde in de tabel is moet de regel verborgen worden. Hier heb ik een formule voor toegevoegd
Helaas kom ik er niet helemaal uit.

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("C6")) Is Nothing Then
Cells.Select
Selection.EntireRow.Hidden = False

Dim rng As Range
Dim x As Integer

For Each c In Range("A5:A250")
If UCase(c.Value) = "X" Then
If x = 0 Then
Set rng = c
x = 1
Else
Set rng = Union(rng, c)
End If
End If
Next

rng.EntireRow.Hidden = True

Range("C6").Select
End If
End Sub
 

Bijlagen

  • Table Search.xlsm
    24,6 KB · Weergaven: 22
Zou zo moeten lukken:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range, rUnion As Range
Dim x As Integer
    
    Set rng = Range("A5:A250")
    For Each c In rng
        If UCase(c.Value) = "X" Then
            If x = 0 Then
                Set rUnion = c
                x = 1
            Else
                Set rUnion = Union(rUnion, c)
            End If
        End If
    Next
    If x = 1 Then
        rUnion.EntireRow.Hidden = True
    Else
        rng.EntireRow.Hidden = False
    End If
End Sub
 
Hallo AccessGuru

Werkt inderdaad nu prima.
Bedankt alweer
 
Let wel op, de code wordt nu na iedere aanpassing in het werkblad gedraaid. Ik zou de controle op wijziging in cel C6 laten staan.
 
Hier een methode zonder loop, snelheidsverschil zal je hier niet merken

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Address(0, 0) = "C6" Then
    With Range("B13", Range("B" & Rows.Count).End(xlUp))
      .EntireRow.Hidden = False
      .Offset(, -1).ClearContents
      .Offset(, -1).Value = Evaluate(Replace(Replace("if(len(if((@@<>"""")*(row(@@)<>21),%%,""x"")),"""",""#N/A"")", "@@", .Address), "%%", .Offset(, 1).Address))
       On Error Resume Next
      .Offset(, -1).SpecialCells(2, xlErrors).EntireRow.Hidden = True
   End With
 End If
End Sub
 
Code:
  .Offset(, -1).Value = Evaluate(Replace(Replace("if(len(if((@@<>"""")*(row(@@)<>21),%%,""x"")),"""",""#N/A"")", "@@", .Address), "%%", .Offset(, 1).Address))
:eek:???:love:...:thumb:!!!
verklaar je eens nader !
ik begrijp die @@ en die %% niet !
Op 1 of andere manier geeft dat een verwijzing naar de cel zelf waarschijnlijk ?
Heb je ergens een linkje naar een site om dit uit te leggen ?
 
Laatst bewerkt:
:)

Die @@ en die %% worden vervangen door respectievelijk het .address en het .offset(,1).address.

Dat gegeven, komt er in de formule op de plaats van de "@@" bijvoorbeeld B13:B28 te staan.
Op de plaats van %% staat dus eigenlijk C13:C28

De tekens @@ en %% zouden dus net zo goed andere tekens kunnen zijn.;)

Documentatie hierover heb ik helaas niet. In de bijlage nog een klein voorbeeldje.
 

Bijlagen

  • vb.xlsm
    14,7 KB · Weergaven: 16
o, poepsimpel
 
Op het eerste gezicht dus niet;)
 
ik kom er niet uit met en + of in je voorbeeldje !
kolommen A & B met output naar C
of a 1 of b 0 => "Test1"
of a 0 of b 1 => "Test2"
dus bv. in A en a en in B een 1 = in C "Test1"
 

Bijlagen

  • vb.xlsm
    21,2 KB · Weergaven: 12
Gebruik het als matrix formule om de output in zijn geheel weg te schrijven.

Code:
=IF(((A1:A16="a")*(B1:B16=1))+((A1:A16="b")*(B1:B16=0)),"Test1","etc")

Vertaald naar de evaluate regel:

Code:
Sub jec()
 With Range("A1:A16")
    .Offset(, 2).Value = Evaluate(Replace(Replace("if(((##=""a"")*(%%=1))+((##=""b"")*(%%=0)),""Test1"",""etc"")", "##", .Address), "%%", .Offset(, 1).Address))
 End With
End Sub

Op deze manier kun je al je matrix formules in VBA gebruiken.
Als je meer verschillende bereiken in je formule hebt, wordt het wel wat onoverzichtelijk. Gebruik er zelf eentje met 4x een replace in 1 regel, dat vind ik persoonlijk al ten koste van overzicht gaan.

Tip: gebruik als teken(bvb: ##) geen dollartekens. Wanneer je die als laatste gaat vervangen, worden alle "absolute" verwijzingen vervangen door "relatieve" verwijzingen. Dat gaat een foutmelding geven binnen Evaluate.

Code:
MsgBox Range("A1:A16").Address
 
Laatst bewerkt:
Toen was het stil
 
ju, bij mij is het licht bijna uit ...
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan