Verticaal Zoeken

[marcel31281]

Ik ben gevraagd de planning van ons bedrijf te upgraden, nu zou ik graag willen dat als in kolom F de code gekozen word in Kolom H de tekst komt te staan die daar bij hoort. ( zie blad 2 )
Omdat het invullen van de cellen variabel is kan ik geen formule gebruiken, want bij deleten van de info in de cel is ook de formule weg.

Wat moet ik doen om dit in vba voor elkaar te krijgen?

Alvast bedankt

Mod edit: Bestand verwijderd i.v.m. privacy gevoelige info.

 

[popipipo]

Omdat het invullen van de cellen variabel is

Over welke cellen heb je het hier?

 

[marcel31281]

De cellen in kolom H

 

[popipipo]

Waarom zou je dan geen vert.zoeken formule kunnen gebruiken?

=ALS(F12="";"";VERT.ZOEKEN(F12;Blad2!$A$13:$B$21;2;0))

 

[marcel31281]

Als iemand de tekst in H verwijdert, dan is de formule toch ook weg?

Of denk ik verkeerd

 

[popipipo]

Ja, dat is waar maar dat geldt voor elke cel.
Als iemand alles verwijderd ben je alles kwijt.
Mensen die het bestand gebruiken moeten natuurlijk wel ingelicht worden wat ze wel en niet moeten doen.

Een beveiliging er op zetten zodat de formule in de cel, en alle cellen die niet verwijderd mogen worden, niet per ongeluk gewist wordt is misschien een betere oplossing.

 

[marcel31281]

Super Bedankt voor je reactie, echter zou ik toch ook een oplossing in VBA willen proberen om te kijken wat beter werkt.
Ik ga zeker kijken naar de oplossing hierboven van jou om te zien of dit gaat werken voor ons.

Maar probleem blijft dat alle cellen in H ook vrij in te vullen moeten zijn, maar zodra 1 van de codes in F gekozen wordt moet de tekst die daar bij hoort er komen te staan.

 

[AD1957]

Zo?

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F12:F20")) Is Nothing Then
   Set c = Sheets("Blad2").Columns(1).Find(Target.Value, , , xlWhole)
        If Not c Is Nothing Then
           Target.Offset(, 2).Value = c.Offset(, 1).Value
        End If
End If
End Sub

En verwijder het bestand in post 1 vanwege privacy

 

[HSV]

Het bestand is weg dus geen idee waar je op zoekt in kolom A van blad2.

Als het een datum (ook een getal in Excel) is of getallen zijn geeft de Find methode niet altijd een waarde retour.
Dat heeft ook met de opmaak te maken.
Bv. in kolom A van blad2 staat 6758485 en de opmaak is 'getal' met 2 decimale cijfers (6758485,00), dan zul je het getal 6758485 niet vinden als je die in typt in blad1.

Eventuele toevoeging in de code van Albert zou 'xlformulas' moeten zijn.
Een datum zoeken is al helemaal een drama als daar een exotische opmaak op zit.
Dan zou je beter over kunnen schakelen op de 'Match' functie.

Het is maar dat je het weet.

 

[AD1957]

Hier het bestand zonder gevoelige info.

Harry,

Ik wist niet dat de Find methode deze problemen kon opleveren. Weer iets geleerd.:d
In het voorbeeld bestand verwacht ik deze problemen niet.
Toch maar de code aangepast met Application.Match .

 

[marcel31281]

Super bedankt voor al jullie reacties :thumb::thumb::thumb:

Het werkt inderdaad zoals ik bedoelde, en bedankt voor het verwijderen van het bestand ik heb denk ik de verkeerde geupload

 

[popipipo]

Persoonlijk heb ik een hekel aan de worksheet events want dan werkt de undo knop niet meer.

 

[HSV]

De Undo is bijna gelijk aan de spiegels aan je auto, waar je langs gekomen bent hoef je niet meer naar te kijken. :d

 

[AD1957]

Persoonlijk heb ik een hekel aan de worksheet events want dan werkt de undo knop niet meer.

Daar komen bijna zeker nog vragen over.

Misschien dit er nog bijzetten in het Change.event

if target="" then target.offset(,2)=""

 

[popipipo]

waar je langs gekomen bent hoef je niet meer naar te kijken

Dat is wel heel kort door de bocht, bovendien is het verplicht om spiegels in je auto te hebben.

Ik wilde alleen maar waarschuwen voor het bij effect.

 

[HSV]

Weet ik toch Willem. :d:d

 

[marcel31281]

Beste Forumleden,

Is er een manier om onderstaande code aan te passen zodat hij voor heel het blad werkt?? Op de manier waarop ik nu bezig ben zou ik voor elke monteur weer deze code moeten kopieren en aanpassen en dat is best veel tikwerk
Er komen namelijk nog een stuk of 12 monteurs bij in de planning

If Not Intersect(Target, Range("J10:J20")) Is Nothing Then
        Rnr = Application.Match(Target.Value, Sheets("Blad2").Columns(1), 0)

        If IsNumeric(c) And Target.Count = 1 Then
           Target.Offset(, 2).Value = Sheets("Blad2").Cells(Rnr, 2).Value
           If Target = "" Then Target.Offset(, 2) = ""
        End If
        
        
'        If Target = "" Then Target.Offset(, 2) = ""

End If

Alvast bedankt

 

[AD1957]

If Not Intersect(Target, Range("F10:F20, J10:J20", etc, etc)) Is Nothing Then

 

[marcel31281]

Soms is de oplossing zo simpel, en zit ik weer veel te moeilijk te denken..... zal door de warmte komen denk ik

Super bedankt in ieder geval voor je reactie

 

[VenA]

Beetje vreemde code. c krijgt nergens een waarde waarom dan controleren of het een getal is. De validatielijst voorkomt dat je niet bestaande waarden kan invoeren. Hoef je ook niet op te controleren wat je nu ook al niet doet.
Een cel met validatie is een specialcell maak hier dan ook gebruik van.

De hele code is te reduceren tot 1 regel

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Columns(6).SpecialCells(-4174)) Is Nothing And Target.Count = 1 Then Target.Offset(, 2) = Sheets("Blad2").Cells(Application.Match(Target.Value, Sheets("Blad2").Columns(1), 0), 2)
End Sub