Productcode ingeven

  • Onderwerp starter Onderwerp starter EfBe
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
E

EfBe

Gebruiker
Lid geworden
15 dec 2008
Berichten
45
Beste forumleden,
Ik wil een code toevoegen aan een pakket.
In kolom 1 staat de naam van het pakket.
In kolom 14 staat een verzameling van +- 35 productcodes.
Ik wil eerst kijken of de ingegeven code reeds voorzien is.
Code: 
Productcode = Application.InputBox("Geef de productcode in aub.", "Code", "Z124", Type:=2)
'Inhoud ActiveCell = "'S123,S509,Z124,Z599,S413"
ActiveCell.Value = ActiveCell & "," & Productcode
Wie kan me hierbij helpen
 
Begin eens met een voorbeeldbestandje; aan alleen code hebben we niet zoveel. En kan het niet simpel met Vert.Zoeken?
 
Een voorbeeld is inderdaad handiger. Ook is de code niet compleet.

Misschien zo.

Code: 
ProductCode = Application.InputBox("Geef de productcode in aub.", "Code", , , , , , 2)
  x = Application.Match(ProductCode, Columns(14), 0)
  If IsNumeric(x) Then
    If InStr(ActiveCell.Value, ProductCode) = 0 Then ActiveCell.Value = ActiveCell.value & "," & ProductCode
  End If
 
Laatst bewerkt:
Octafish en VenA, bedankt voor jullie reactie.
In bijlage voorbeeld.
Private Sub Worksheet_Change(ByVal Target As Range)
Deze routine wil ik uitbreiden: als de code die ingegeven wordt reeds bestaat in de verzameling, eerst verwijderen en achteraan terug toevoegen.
Nu doe ik dat zonder controle.
Hopelijk is dit duidelijker
 
Laatst bewerkt door een moderator:
Bestudeer de code in #3 eens. In zie geen Change event en geen producten in kolom M (14). Dus veel duidelijker is het niet.
 
14 = n
 
@VenA Inderdaad uw code die je meegaf in #3 is compleet juist. Maar dat is niet mijn probleem
Het bijgevoegde document heb ik aangepast.
Vooraleer de inhoud van gegeven cel te wijzigen wil ik graag zien of code reeds voorkomt in die cel.
Voorbeeld cel N21: S123,S413,Z124,S509,S599 wordt dan S123,S413,S509,S599,Z124 na toevoegen van "Z124"
En dus niet zoals nu S123,S509,S413,Z124,S509,S599,Z124

Ander voorbeeld cel N23: S123,S509,S413,S509,S599,S123,Z129 wordt dan S123,S413,S599,S123,Z129,S509 na toevoegen van "S509"
En dus niet zoals nu S123,S509,S413,S509,S599,S123,Z129,S509

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveCell.Column <> 14 Then Exit Sub

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .EnableEvents = False
End With

If Not Intersect(Target, Range("KeuzeProducten")) Is Nothing Then
    'Hier wil ik graag een controle doen of de ingegeven code reeds gebruikt is
    'Als code "Z124" reeds voorkomt in de gegeven cel dan "Z124" verwijderen en achteraan bijvoegen
    
    'Op welke rij staat de ingegeven code?
    W = Columns(19).Find(Left(Split(Target, ",")(UBound(Split(Target, ","))), 3), , xlValues, 1).Row
    If UBound(Split(Target, ",")) > 0 Then
        Target = Left(Target, Len(Target) - (Len(Split(Target, ",")(UBound(Split(Target, ",")))) + 1)) & "," & Cells(W, 19)
    Else
        Target = Cells(W, 19)
    End If
End If

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .EnableEvents = True
End With
End Sub
 
Laatst bewerkt door een moderator:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("KeuzeProducten")) Is Nothing Then
 Application.EnableEvents = False
  Target = Join(Filter(Split(Target.Value, ",", UBound(Split(Target, ",")) + 1), Split(Target, ",")(UBound(Split(Target, ","))), 0), ",") & "," & Split(Target, ",")(UBound(Split(Target, ",")))
 Application.EnableEvents = True
End If
End Sub

Of iets korter.
Code: 
Target = Join(Filter(Split(Target.Value, ",", [COLOR="#FF0000"]- 1[/COLOR]), Split(Target, ",")(UBound(Split(Target, ","))), 0), ",") & "," & Split(Target, ",")(UBound(Split(Target, ",")))
 
Laatst bewerkt:
Op verzoek van TS attachments verwijderd.
 
@HSV,
Super bedankt! Beide versies (de lange en de korte) werken perfect.
Deze oplossing heb ik geïntegreerd in mijn applicatie.
Ik heb er nog wel wat werk aan om te begrijpen hoe het werkt.

Mag ik nog een vraagje stellen. Nadat een productcode is toegevoegd tel ik nog voor elke productcode hoe dikwijls die voorkomt.
Dit doe ik nu met 2x een For/Next aantal rijen en een tweede aantal producten per rij.
 
Plaats een bestand dat niet verwijderd hoeft te worden, waardoor de volledige draad onbegrijpelijk wordt.
 
Je For Each code staat er niet in, wat moet er geteld worden is me nu een raadsel.
 
Hallo Harry,
In bijlage met For/Next code
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("KeuzeProducten")) Is Nothing Then
  Application.EnableEvents = False
  'Target = Join(Filter(Split(Target.Value, ",", UBound(Split(Target, ",")) + 1), Split(Target, ",")(UBound(Split(Target, ","))), 0), ",") & "," & Split(Target, ",")(UBound(Split(Target, ",")))
  Target = Join(Filter(Split(Target.Value, ",", -1), Split(Target, ",")(UBound(Split(Target, ","))), 0), ",") & "," & Split(Target, ",")(UBound(Split(Target, ",")))

  Set Rng = Range("KeuzeProducten")
    For W = 12 To 19
      Zoekwat = Cells(W, 19)
      Range("P" & W).Value = 0
      For Rij = 1 To Rng.Rows.Count
        'temp = Split(Target, ",")(UBound(Split(Target, ",")))
        For I = 0 To UBound(Split(Rng.Cells(Rij, 1), ","))
          If Split(Rng.Cells(Rij, 1), ",")(I) = Zoekwat Then
            Range("P" & W).Value = Range("P" & W).Value + 1
          End If
        Next I
      Next Rij
    Next W

Application.EnableEvents = True
End If
End Sub
 

Bijlagen

Hierbij heb je de gegevens in kolom S niet nodig.

Onderstaande zoekt zelf uit welke codes je hebt getypt.
Ik laat ze wegschrijven naar de kolommen V en Y, maar kan jezelf aanpassen.


Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("KeuzeProducten")) Is Nothing Then
  Application.EnableEvents = False
  Target = Join(Filter(Split(Target.Value, ",", -1), Split(Target, ",")(UBound(Split(Target, ","))), 0), ",") & "," & Split(Target, ",")(UBound(Split(Target, ",")))
  sv = Range("keuzeproducten")
  With CreateObject("scripting.dictionary")
    For i = 1 To UBound(sv)
    a = Split(sv(i, 1), ",", -1)
      For j = 0 To UBound(a)
         .Item(a(j)) = .Item(a(j)) + 1
      Next j
    Next i
    ReDim b(.Count, 3)
    For j = 0 To .Count - 1
      b(j, 0) = .Item(.keys()(j))
      b(j, 3) = .keys()(j)
     Next j
   Cells(12, 22).Resize(.Count, 4) = b
  End With
 Application.EnableEvents = True
End If
End Sub

Dit stukje...

Code: 
  ReDim b(.Count, 3)
    For j = 0 To .Count - 1
       b(j, 0) = .Item(.keys()(j))
       b(j, 3) = .keys()(j)
   Next j
   Cells(12, 22).Resize(.Count, 4) = a

...mag je ook zo schrijven.
Code: 
Cells(12, 22).Resize(.Count) = Application.Transpose(.items)
Cells(12, 25).Resize(.Count) = Application.Transpose(.keys)

Maar dan schrijf je twee keer naar het werkblad i.p.v. een.

Hoeven er geen lege kolommen tussen kan het zo.
Code: 
Cells(12, 22).Resize(.Count,2) = Application.Transpose(array(.items, .keys))
 
Laatst bewerkt:
Harry bedankt, werkt super.;)
Ik de code aangepast.
Zo kom ik in de kolommen die ik nu gebruik
Code: 
    Cells(12, 16).Resize(.Count) = Application.Transpose(.items)
    Cells(12, 19).Resize(.Count) = Application.Transpose(.keys)
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan