Een paar kleine VBA vraagjes....

Djoane · 2 aug 2011

Hallo allemaal,

Bedankt alvast voor het lezen!

Ik heb een aantal vragen:

1. Ik zou graag een zoekfunctie willen waarmee ik een gedeelte van een inhoud van een cel kan zoeken. Nu doe ik dit met sterretjes, maar ik zou graag willen dat het ook zonder sterretjes ging. Zie (foute) VBA code hieronder..

2. Is er een mogelijkheid, om een bepaalde Kolom, automatisch met hoofdletters te laten schrijven? Ik moet steeds hoofdletters en nummers invoeren (een code..) En ik zou het fijn vinden als ik niet steeds op Shift hoef te drukken. (Caps Lock is ook geen optie, omdat ik nog meer moet invullen dan alleen dat vakje..) Ik doe het nu steeds met behulp van ASAP Utilities achteraf. Via celeigenschappen is ook geen optie volgens mij, omdat de codes niet altijd hetzelfde zijn. Is daar dus een eenvoudige VBA code voor?

Foute VBA code:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("H1")) Is Nothing Then Exit Sub
  If Range("H1") = "" Then
    ActiveSheet.Range("$H$1:$J$" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter Field:=1
  Exit Sub
  End If
ActiveSheet.Range("$H$1:$J$" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter Field:=1, Criteria1:=Range("H1").Value
End Sub

Warme bakkertje · 2 aug 2011

Als antwoord op je 2de vraag, invoer in kolom A

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 Then
        Application.EnableEvents = False
        Target = UCase(Target)
        Application.EnableEvents = True
    End If
End Sub

Voor wat betreft je 1ste vraag zou een voorbeeldbestandje welkom zijn.

Joske2000 · 2 aug 2011

Ik doe een gokje voor vraag 1

Code:

ActiveSheet.Range("$H$1:$J$" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter 1, "=*" & range("H1").Value & "*"

Joske

Djoane · 2 aug 2011

@Joske, Bedankt! Dat werkt. Probleem nr 1 is dus opgelost.

@Warme Bakker, het doet het niet... Als ik die 1 door een 6 vervang, dan hebben we het over Kolom H? Toch? (Ik ben nog niet zo'n held met VBA.....)

HSV · 2 aug 2011

De 6e letter in het alfabet is de F, doe er twee bij en je komt uit op H.

Djoane · 2 aug 2011

Oh ja, sorry!

Maar ik heb alle Kolommen uitgeprobeerd, maar het doet 't nog niet..

HSV · 2 aug 2011

Werkt perfect overigens.
Heb je de code wel in het juiste moduleblad gezet?

Djoane · 2 aug 2011

Het zou zomaar kunnen dat ik het verkeerd gedaan heb.

Ik heb de code in hetzelfde blad neergezet, als waar de andere code staat. Moest hij ergens anders?

HSV · 2 aug 2011

Je kan maar één keer de "Private Sub Worksheet_Change(ByVal Target As Range)" gebruiken in hetzelfde moduleblad, dus zul je het moeten combineren.

Roncancio · 2 aug 2011

Gewoon de code achter het werkblad plaatsen zoals je in je voorbeeldcode al hebt gedaan.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Chr(64 + Target.Column) = "H" And Not Target Like UCase(Target) Then Target = UCase(Target)

End Sub

Met vriendelijke groet,

Roncancio

Djoane · 2 aug 2011

Ik kom er echt niet uit jongens, ik heb hem ertussen, eronder, erboven en nog net niet erin geplakt, en ik krijg hem niet voor elkaar. Tijdens het puzzelen merkte ik dat hij automatisch een filter toepast. Als ik er over de hele rij een aantal heb staan, pakt hij automatisch de eerste. (Als ik die 1 in een 2 verander, pakt hij de volgende.. Logisch..)

Maar is het ook mogelijk om hem in alle cellen te laten zoeken, en dan ook alle rijen te laten zien? Misschien zelfs met een kleurtje? Ik zou niet weten hoe, maar daar hebben jullie vast nog 101 ideeën over

Hieronder zoals ik de code nu heb. Als ik die andere ertussen zet, doet hij het echt niet. Ik weet niet hoe dat komt.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G1")) Is Nothing Then Exit Sub
If Range("G1") = "" Then
ActiveSheet.Range("$g$1:$J$" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter Field:=1
Exit Sub

End If
ActiveSheet.Range("$g$1:$J$" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter 1, "=*" & Range("g1").Value & "*"
End Sub

P.s. Het is cel G die ik moest hebben.. Niet H... Dat krijg je als je met meerdere bestanden tegelijk werkt

Excuus.. Bedankt voor het helpen jongens

Djoane · 2 aug 2011

Nogsteeds aan het prutten... T lukt tot nu toe nog niet...

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G1")) Is Nothing Then Exit Sub
If Range("G1") = "" Then
ActiveSheet.Range("$g$1:$J$" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter Field:=1
Exit Sub

End If
ActiveSheet.Range("$g$1:$J$" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter 1, "=*" & Range("g1").Value & "*"
Exit Sub

If Not Intersect(Target, Range("G")) Is Nothing Then
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
End If

End Sub

Vond deze laatste code via google.. Maar volgens mij ligt het niet aan de codes.. Maar aan mij! Ik weet het gewoon niet..

Roncancio · 2 aug 2011

Volgens mij volstaat onderstaande code:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G1:J1")) Is Nothing  And Not Target Like UCase(Target) Then Then
    Target = UCase(Target)
    ActiveSheet.Range("$g$1:$J$" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter Target.Column - 6, "=*" & Target.Value & "*"
End If
End Sub

Als in het bereik G1 t/m J1 iets wordt gewijzigd dan wordt er gefilterd op de ingevoerde waarde in de betreffende kolom.
Ik ben overigens niet bepaald een voorstander van Exit Sub.
Deze zijn vaak onnodig en kunnen zelfs voor onverwachte resultaten zorgen bij lussen.

Met vriendelijke groet,

Roncancio

Djoane · 3 aug 2011

Het lijkt te werken...

Maar nu wordt alleen mijn "Zoekterm" in hoofdletters gezet. En het gaat er juist om dat alles daaronder automatisch in hoofdletters komt... Als ik bijvoorbeeld "59-e52-a" intik, dan zou ik graag willen dat het automatisch "59-E52-A" wordt..

Ennnnn als ik niets invul als "Zoekterm", en ik druk dan op enter, dan gebeurd er helemaal niets.... Ik moet dus dan alsnog met mijn muis naar het filter toe.. Met de "Oude" code werkte het zoeken opzich prima.. alleen die hoofdletter erbij.. Dat lukt nog niet..

Roncancio · 3 aug 2011

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G1:J1")) Is Nothing Then
    Dim r As Range
        ActiveSheet.Range("$g$1:$J$" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter Target.Column - 6, "=*" & Target.Value & "*"
        If Target <> "" Then
            For Each r In ActiveSheet.Range(Target.Offset(1, 0).Address & ":" & Cells(Rows.Count, Target.Column).End(xlUp).Address)
               If Not r.Value Like UCase(r.Value) And r.Rows.Hidden = False Then r.Value = UCase(r.Value)
            Next
        End If
End If
End Sub

Met vriendelijke groet,

Roncancio

Djoane · 3 aug 2011

Roncancio, die werkt prima!

Hij maakt er hoofdletters van zodra ik de zoekfunctie een keer gebruikt heb. Kan het ook automatisch, zonder dat ik die zoekfunctie moet gebruiken?

Ik weet het, ik ben heel vervelend....

Roncancio · 3 aug 2011

Code:

Sub hoofdletters()
Dim r As Range
    For Each r In Range("G1").CurrentRegion
        If r.Row > 1 Then r.Value = UCase(r.Value)
    Next
End Sub

Bovenstaande code maakt hoofdletters van het bereik vanaf G1.

Anders weet ik niet precies wat je bedoelt.

Met vriendelijke groet,

Roncancio

Warme bakkertje · 3 aug 2011

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("G1:J1")) Is Nothing Then
        ActiveSheet.Range("$G$1:$J$" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter 1, "=*" & Range("G1").Value & "*"
    End If
    If Not Intersect(Target, Range("G2:G" & Cells(Rows.Count, 2).End(xlUp).Row)) Is Nothing Then
        If Target <> "" Then Target = UCase(Target)
    End If
End Sub

Djoane · 3 aug 2011

Ik heb maar even mijn bestandje ge-upload..

Als ik in het zoekveld iets intik, krijg ik keurig het antwoord te zien. Maar als ik hem dan leeg maak, en weer op enter druk, krijg ik een beperkt bereik, hij heeft dan toch nog een of ander autofilter aan staan.. Ik wil dus juist niet op die knop hoeven drukken..

Hoofdletters vind ik prima.. Die is nu gelinked aan de zoekopdracht, maar het was meer de bedoeling dat het een opzichzelfstaand iets was. (Dus als ik iets in die Kolom intik, dat het dan hoofdletters worden zodra ik de cel verlaat (enter).

Warme bakkertje · 3 aug 2011

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("G1")) Is Nothing Then
        If Target = "" Then ActiveSheet.AutoFilterMode = False: Rows("4:4").Hidden = True: Exit Sub
        ActiveSheet.Range("$G$4:$J$" & Cells(Rows.Count, 2).End(xlUp).Row).AutoFilter 1, "=*" & Range("G1").Value & "*"
    End If
    If Not Intersect(Target, Range("G5:G" & Cells(Rows.Count, 2).End(xlUp).Row)) Is Nothing Then
        If Target <> "" Then Target = UCase(Target)
    End If
End Sub

Een paar kleine VBA vraagjes....

Gebruiker

Meubilair

Terugkerende gebruiker

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Inventaris

Meubilair

Gebruiker

Gebruiker

Meubilair

Gebruiker

Meubilair

Gebruiker

Meubilair

Meubilair

Gebruiker

Bijlagen

Meubilair

Wij waarderen jouw privacy