vba code cel verwijzing zoeken en schrijven

[joeyverveer]

Hallo,

Laat ik eerst vooropstellen dat ik weinig kennis heb met betrekking tot vba programmeren
maar ik ga toch een poging wagen.

Ik werk in een sigarettenzaak, waar we ook kraslotjes verkopen.
Deze dienen bij ontvangst bevestigd te worden voor administratieve doeleinde

nu pennen we nog alles met de hand, maar bij drukke dagen zou simpel scannen een pre zijn.

ik heb zelf al een begin gemaakt, echter is deze code niet ideaal gezien het assortiment kraslotjes nogal eens veranderd, en dus de data ook.

ik maak nu gebruik van 2 aparte case statement, 1 welke de naam zoek 1 welke de waarde zoekt.

ik zou graag willen zoeken op pakketnr op blad 2 waarbij hij de waarde en de naam overneemt naar blad 1

wie kan mij helpen, ik heb zelfs al geprobeerd wat te kooien met offset, en dan zo naar andere cellen als actief te schrijven maar ik mis gewoon de kennis....

wie ow wie kan mij helpen

 

[E v R]

Een aanzetje; plaats de code in het codegedeelte van Blad1 (rechtermuisklik op de tab, programmacode weergeven)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim spelnr As Integer, i As Integer
    If Target.Count > 1 Then Exit Sub
    If Target.Row > 4 And Target.Column = 1 Then
        On Error GoTo fout:
        spelnr = Left(Target, 2)
        i = Application.WorksheetFunction.Match(spelnr, Sheets("Blad2").Range("A2:A" & Sheets("Blad2").Cells(Rows.Count, "A").End(xlUp).Row), 0)
        Target.Offset(0, 1).Value = spelnr
        Target.Offset(0, 2).Value = Mid(Target, 3, 6)
        Target.Offset(0, 3).Value = Sheets("Blad2").Cells(1 + i, 2).Value
        Target.Offset(0, 4).Value = Sheets("Blad2").Cells(1 + i, 3).Value
        Exit Sub
fout:
        MsgBox "Er is een spelnummer gescand wat nog niet in de lijst staat"
    End If

End Sub

 

[joeyverveer]

Een aanzetje; plaats de code in het codegedeelte van Blad1 (rechtermuisklik op de tab, programmacode weergeven)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim spelnr As Integer, i As Integer
    If Target.Count > 1 Then Exit Sub
    If Target.Row > 4 And Target.Column = 1 Then
        On Error GoTo fout:
        spelnr = Left(Target, 2)
        i = Application.WorksheetFunction.Match(spelnr, Sheets("Blad2").Range("A2:A" & Sheets("Blad2").Cells(Rows.Count, "A").End(xlUp).Row), 0)
        Target.Offset(0, 1).Value = spelnr
        Target.Offset(0, 2).Value = Mid(Target, 3, 6)
        Target.Offset(0, 3).Value = Sheets("Blad2").Cells(1 + i, 2).Value
        Target.Offset(0, 4).Value = Sheets("Blad2").Cells(1 + i, 3).Value
        Exit Sub
fout:
        MsgBox "Er is een spelnummer gescand wat nog niet in de lijst staat"
    End If

End Sub

Superrrr, mijn hartelijke dank, het lijkt zo op het eerste gezicht prima te functioneren

toppie:thumb: