Inhoud van cel E1 naar S1, volgende keer naar S2, dan S3 enz.

[Evelthoven]

Goedemiddag,

Voordat ik mijn excel-vraag ga stellen wil ik eerst vragen of dat op deze manier wel mag.
Op 19 augustus om 12:37 u. heeft A365 een vraag gesteld met als titel: Keuzelijst met invoervak: hoe intypen?
Om 18:08 heeft JVeer hierop een antwoord gegeven met de oplossing.

Van dit bestand wil ik graag gebruik maken omdat dit bijna hetzelfde probleem behandelt als waar ik een vraag over heb.
Als ik het op deze manier niet mag doen, dan beschouw mijn bericht maar als niet geschreven. Als het wel mogelijk is dan heb ik in de bijlage, Vraag 240820, mijn vraag gesteld.

Hopelijk kan iemand mij voorzien van de oplossing.

Alvast iedereen bedankt.

Groeten,
Eric

 

[SjonR]

zo?

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$1" Then
    If Cells(1, 19).Value <> "" Then
        Cells(Range("S" & Rows.Count).End(xlUp).Row + 1, 19).Value = Cells(1, 5).Value
    Else
        Cells(1, 19).Value = Cells(1, 5).Value
    End If
End If
End Sub

 

[Senso]

Van dit bestand wil ik graag gebruik maken omdat dit bijna hetzelfde probleem behandelt als waar ik een vraag over heb.

Maak er gerust gebruik van. Daar is Helpmij.nl voor.

Een forum is een publieke aangelegenheid, iedereen kan het lezen, waar ook ter wereld. Dat maakt dat een forum één grote vergaarbak van kennis is, met de zoekfunctie alleen al kom je erg veel te weten. De inhoud is volgens mij vrij. Het klakkeloos overnemen van tekst en/of afbeeldingen van door auteursrechten beschermde bronnen is 'not done'.

Vermeld nooit je e-mail adres, privégegevens en persoonlijke gegevens bij berichten. Kwaadwillenden kunnen misbruik van deze gegevens maken.

 

[JEC.]

@SjonR, als je nu gedeeltelijk een tekst invult en vervolgens een van de keuzes selecteert, wordt de keuze dubbel in de kolom gezet.
Als je het zo schrijft wordt dat voorkomen

*zie vervolg*

 

[HSV]

De "On Error resume next' is nergens voor nodig.

Waarom wordt cel S1 weer leeggemaakt als E1 leeg is en bij een volgende keer weer in S1 komt.
Dit kan ook wel iets anders.

Cells(Range("S" & Rows.Count).End(xlUp).Row + 1, 19)

cells(rows.count,19).end(xlup).offset(1)

 

[JEC.]

Harry, ik krijg een foutmelding als ik die error resume next weglaat. Wat is daarvoor een geschikte oplossing?
Het leegmaken van S1 had ik inderdaad over het hoofd gezien.

Zo werkt het naar behoren. Hoe om te gaan met de error?

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Address = "$E$1" Then
a = Application.Match([E1].Value, Range("A1:A10"), 0)
    If Cells(1, 19).Value <> "" And IsNumeric(a) Then
        Cells(Rows.Count, 19).End(xlUp).Offset(1) = Target.Value
    ElseIf Target <> "" And IsNumeric(a) Then Cells(1, 19).Value = Target.Value
    End If
End If
End Sub

 

[HSV]

Ik krijg geen foutmelding als ik het weglaat.

Waarom moet er eigenlijk een match gevonden worden?
S1 = target toch?; idem dito voor de rest.

 

[JEC.]

Ik heb getest met de eerste code van SjonR. Wanneer je bijvoorbeeld "Amster" intypt en vervolgens amsterdam selecteert zul je zien dat "Amsterdam" 2x wordt gekopieerd in kolom S.
Dit heb ik onderdrukt door een absolute match te laten zoeken in de dropdown gegevens.

 

[HSV]

Als ik "Amster' typ, en je kan een keuze maken maar doet het niet,....wat dan?

 

[JEC.]

Jij kan de validatie niet bekijken toch?

Je krijgt deze fout en komt voort uit de application.match.

 

[HSV]

Ik typ bv. een 'b' en de cursor knippert nog kan ik gelijk een keuze maken.
Nog steeds geen foutmelding met wat ik ook doe.

 

[JEC.]

Het verschil is dus dat ik op het pijltje moet klikken voordat ik een keuze kan maken. Dat zorgt dan ook voor de foutmelding
De application.match zorgt er trouwens tegelijkertijd ook voor dat het kopiëren van incomplete namen zich niet voor kan doen(foutmelding bij invoer van ongeldige gegevens staat uitgevinkt)

 

[HSV]

Ik moet ook op het pijltje klikken, dan pas zie ik de keuzes.
Maak ik geen keuze krijg je toch het getypte in cel S1?

 

[JEC.]

Als ik geen keuze maak verschijnt het getypte inderdaad maar als ik iets typ zoals "bruss" verschijnt het niet

 

[HSV]

Typ eens één letter en maak een keuze.

 

[JEC.]

Ik had de verkeerde code ingevoegd. Probeer het nu eens

 

[cow18]

Private Sub Worksheet_Change(ByVal Target As Range)
   With Range("E1")                              'onze cel
      If Intersect(Target, .Cells(1)) Is Nothing Then Exit Sub   'heb je die veranderd ?
      If Len(.Value) <> "" And IsNumeric(Application.Match(.Value, Range("A1:A10"), 0)) Then Cells(Rows.Count, 19).End(xlUp).Offset(1) = .Value   ' ze is niet leeg en komt voor in je lijstje -> doorkopieren
   End With
End Sub

eventueel moet er niet gecheckt worden op len(.value), het zou geen verschil maken, enkel in het kopje.

 

[HSV]

Het vervelende aan deze materie is dat het twee keer de code doorloopt.
Waarschijnlijk een keer voor het typen van de letter en daarna als je een keuze hebt gemaakt (target.value geeft in beide gevallen de waarde van de validatielijst aan als je een keuze maakt, vreemd dat het toch twee keer de code doorloopt).

Ook al gebruik je enableevents (false,true).
Bij een rechtstreekse keuze in de validatie heb je dat niet.

Private b As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$E$1" Then
    If IsNumeric(Application.Match(Target.Value, Columns(1), 0)) And b = False Then
        Cells(Rows.Count, 19).End(xlUp).Offset(IIf(Cells(1, 19) = "", 0, 1)).Value = Target
        b = True
      Else
        b = False
    End If
  End If
Application.EnableEvents = True
End Sub

Wat hier nog aan ontbreekt is dat als je een letter typt daarna je keuze maakt (dat gaat prima, schrijft een keer weg), maar daarna weer op dezelfde keuze klikt.
Dan komt het niet in kolom S terecht.
Nog een keer doen dan wel (logisch → b = false).

Of je maakt target leeg zodat het niet nog een keer weggeschreven kan worden.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$E$1" Then
        Cells(Rows.Count, 19).End(xlUp).Offset(IIf(Cells(1, 19) = "", 0, 1)).Value = Target
        Target = ""
    End If
Application.EnableEvents = True
End Sub

 

[JEC.]

Ik vind de combinatie van Worksheet_Change met targets en dropdown menu’s niet prettig werken. Bij de code van Cow krijg ik dezelfde error. Ik zal morgen deze eens testen

 

[cow18]

wat is er mis met :
- mijn macro
- dat die macro eventueel 2 keer doorlopen wordt
- met de combi targets en dropdowns