Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Macro Verticaal zoeken

1,143 views
Skip to first unread message

martin...@hotmail.com

unread,
Mar 4, 2009, 5:59:29 AM3/4/09
to
Hallo,

Ik wil graag een macro hebben die de verticaal zoekfunctie gebruikt
omdat gewoon verticaal zoeken om bepaalde reden niet mag.

Ik heb een blad: Contracten. Op dit blad staan in kolom A de
contracten en in kolom B de omschrijving van het contract dus bijv:

Contract Omschrijving
1 Het 1 contract
2 Het 2 contract
3 Het 3 contract
4 Het 4 contract
5 Het 5 contract

Nu heb ik nog een blad: AFW Responsetijd.
Hier kun je in kolom A het contract invullen. Ik wil vervolgens dat in
colom B de omschrijving van dat contract komt.

Weet iemand hoe dit moet?

Groeten Martin

Kweenie

unread,
Mar 4, 2009, 6:44:56 AM3/4/09
to

=VERT.ZOEKEN(A1;Contracten!A1:B5;2;0)

Formule in B1 en zoekwaarde in A1
zou het moeten doen.

Mvg

Piet

martin...@hotmail.com

unread,
Mar 4, 2009, 7:22:44 AM3/4/09
to
> Piet- Tekst uit oorspronkelijk bericht niet weergeven -
>
> - Tekst uit oorspronkelijk bericht weergeven -

Ik wil graag een macro die dit voor mij doet ipv een verticaal
zoekfunctie in een cel. Maar toch bedankt.

Iemand anders een idee?

lab...@gmail.com

unread,
Mar 4, 2009, 11:15:08 AM3/4/09
to
> Iemand anders een idee?- Tekst uit oorspronkelijk bericht niet weergeven -

>
> - Tekst uit oorspronkelijk bericht weergeven -

Mischien heb je hier iets aan
Worksheets("Contracten").Cells(1, 2).FormulaLocal = "=VERT.ZOEKEN
(A1;Contracten!A1:B5;2;0) )"

martin...@hotmail.com

unread,
Mar 5, 2009, 8:00:08 AM3/5/09
to
> (A1;Contracten!A1:B5;2;0) )"- Tekst uit oorspronkelijk bericht niet weergeven -

>
> - Tekst uit oorspronkelijk bericht weergeven -

Ik ben er nog niet uit, iemand anders nog een idee?

Hanno

unread,
Mar 5, 2009, 8:56:03 AM3/5/09
to
Plaats onderstaande routines in de module van AFW Responsetijd

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
Target.Offset(0, 1).Value = ContrOmschr(Target.Value)
End If
End Sub

Private Function ContrOmschr(n As Variant) As String
Dim fContract As Range
Set fContract = Blad1.Columns(1).Find(What:=n, LookIn:=xlValues,
LookAt:=xlWhole)
If fContract Is Nothing Then
ContrOmschr = "(n/b)"
Else
ContrOmschr = fContract.Offset(0, 1).Value
End If
End Function


Succes!
Hanno

martin...@hotmail.com

unread,
Mar 5, 2009, 10:16:36 AM3/5/09
to

Hanno,

Momenteel vult hij alleen n/b in als ik het contractnummer invul. de
omschrijving haalt hij echter nog niet op. Zit er soms een fout
ergens? Kun je anders een excel bestandje mailen waarin het wel
werkt...?

Groeten Martin

Hanno

unread,
Mar 5, 2009, 10:30:49 AM3/5/09
to
Ik heb bestandje naar je gemaild.

Het is een kwestie van de bladnamen e.d. omzetten naar je eigen
situatie.
Dit is uiteraard een voorbeeld zoals het princiepe werkt.

Laat het gerust weten of het wel of niet gelukt is.

Hanno

lab...@gmail.com

unread,
Mar 5, 2009, 1:02:09 PM3/5/09
to

Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Column = 1 Then
Target.Offset(0, 1).Value = ContrOmschr(Target.Value)

Target.Offset(0, 2).Value = ContrOmschr(Target.Value)
End If
End Sub


Private Function ContrOmschr(n As Variant) As String
Dim fContract As Range

Set fContract = Blad3.Columns(1).Find(What:=n, LookIn:=xlValues,
LookAt:=xlWhole)
Set fContract = Blad3.Columns(2).Find(What:=n, LookIn:=xlValues,
LookAt:=xlWhole)

If fContract Is Nothing Then
ContrOmschr = "(n/b)"
Else

ContrOmschr = fContract.Offset(0, 1, 2).Value

End If
End Function
wie helpt mij
wat doe ik fout

Hanno

unread,
Mar 6, 2009, 4:42:25 AM3/6/09
to
Wat gaat er fout:
Ten eerste Set jij twee keer het object fContract, fContract neemt
alleen de range aan die je als laats hebt gegeven dus die met Columns
(2).

Ten tweede gebruik je de methode Offset verkeerd. Kijk goed in de
helpfunctie over het gebruik van Offset.

Dit is zoals het werkt, start Macro1

Public Function myVERTZOEKEN(waarde As Variant, tabel As Range, kolom
As Byte) As String
'Werkt het zelfde als de werkbladfunctie VERT.ZOEKEN
Dim fWaarde As Range
Set fWaarde = tabel.Columns(1).Find(What:=waarde, LookIn:=xlValues,
LookAt:=xlWhole)
If fWaarde Is Nothing Then
myVERTZOEKEN = False
Else
myVERTZOEKEN = fWaarde.Offset(0, kolom - 1).Value
End If
End Function

Sub Macro1()
Msgbox myVERTZOEKEN("a", Blad1.Range("A1:D11"), 2)
Msgbox myVERTZOEKEN("a", Blad1.Range("A1:D11"), 3)

End Sub

lab...@gmail.com

unread,
Mar 6, 2009, 9:15:37 AM3/6/09
to

Je bent goed bezig, macro van jouw getset werkt perfect,
Sub Macro1()
MsgBox myVERTZOEKEN("test", Blad3.Range("A1:D11"), 2)
MsgBox myVERTZOEKEN("test", Blad3.Range("A1:D11"), 3)
MsgBox myVERTZOEKEN("test", Blad3.Range("A1:D11"), 4)

End Sub

Public Function myVERTZOEKEN(waarde As Variant, tabel As Range, kolom
As Byte) As String
'Werkt het zelfde als de werkbladfunctie VERT.ZOEKEN
Dim fWaarde As Range
Set fWaarde = tabel.Columns(1).Find(What:=waarde, LookIn:=xlValues,
LookAt:=xlWhole)
If fWaarde Is Nothing Then
myVERTZOEKEN = False
Else
myVERTZOEKEN = fWaarde.Offset(0, kolom - 1).Value
End If
End Function

Vraagje i.p.v. de msgBox is het ook mogelijk om de waarde hiervan in
de cellen te zetten, bij voorbaat dank

0 new messages