Hulp nodig bij aanpassen VBA code

[joeyverveer]

Ik heb problemen met het aanpassen van volgende Vba code.
Heb het geprobeerd met een If else statement, maar helaas is me kennis te weinig en te ver weggezakt.

Ik heb voor de winkel een weekoverzichtje gemaakt waar we administratieve dingen bijhouden van die week.
Zo ook de krasloten die in de verkoop gaan (activatie).
Deze kunnen worden gescant in tabblad "Krasloten" waarna hij de waardes uit tabblad "Data" haalt.
Dit ging goed tot spelnr "100" kwam, bij spelnr "100" bestond de scancode uit meer dan 12 cijfers en diende de eerste 3cijfers (digits) als sleutel (spelnr).
Bij minder als 12 cijferreeks als scancode diende de eerst 2cijfers als sleutel (spelnr).
Nu is er een nieuw pakket met scancode beginnende met 01 waarbij het spelnr "1" dient te zijn.
Deze scancode bestaat uit een cijferreeks van 11cijfers waarbij enkel het EERSTE cijfer als sleutel (spelnr) fungeert.

bestaande VBA

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 = IIf(Len(Target) > 12, Left(Target, 3), Left(Target, 2))
    i = Application.WorksheetFunction.Match(spelnr, Sheets("Data").Range("A2:A" & Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row), 0)
    Target.Offset(0, 1).Value = spelnr
    Target.Offset(0, 2).Value = IIf(Len(Target) > 12, Mid(Target, 4, 6), Mid(Target, 3, 6))
    Target.Offset(0, 3).Value = Sheets("Data").Cells(1 + i, 2).Value
    Target.Offset(0, 4).Value = Sheets("Data").Cells(1 + i, 3).Value
    Target.Offset(0, 5).Value = Date
    Exit Sub
fout:
    MsgBox "Er is een spelnummer gescand wat nog niet in de lijst staat"
 End If
End Sub

enkele voorbeelden van scancodes
011098420509 <------- spelnr 1, 11cijfers totaal <!>
011098430010 <------- spelnr 1, 11cijfers totaal <!>
01111168640250 <------- spelnr 111, 13cijfers totaal <werkt>
01171072571203 <------- spelnr 117, 13cijfers totaal <werkt>
01091234380251 <------- spelnr 109, 13cijfers totaal <werkt>
961485450503 <------- spelnr 96, 12cijfers totaal <werkt>


Kortom uitzonderings regel voor een reeks van kleiner dan 12 cijferreeks, sleutel is 1e getal


Alvast mijn hartelijke dank!

gr joey

Bekijk bijlage voorbeeld.xls

 

[wampier]

Maar je eerste voorbeeld heeft toch ook 12 cijfers? niet 11

01 10 98 42 05 09

Maar goed, de rechter 10 getallen zijn altijd de code, wat er overblijft is het spelnr. Dus waarom neem je niet gewoon de rechter 10 en de rest is het spelnr?

 

[joeyverveer]

Ik had het in kladblok gescand en gecopy paste.
Echter kent excel geen 01, dat wordt gewoon 1 (had wel als tekst gekund, maar staat als integer/getal).
Al zou het 00000001, dan maakt excel er nog steeds gewoon 1 van.

En nee de cijferreeks van 6cijfers NA het spelnr zijn het pakket nummer, daarachter scant die nog wat irrelevante cijfers.
Dus het moet echt vanaf links.

 

[joeyverveer]

enkele voorbeelden van scancodes
011098420509 <------- spelnr 1, 11cijfers totaal <!>
011098430010 <------- spelnr 1, 11cijfers totaal <!>
01111168640250 <------- spelnr 111, 13cijfers totaal <werkt>
01171072571203 <------- spelnr 117, 13cijfers totaal <werkt>
01091234380251 <------- spelnr 109, 13cijfers totaal <werkt>
961485450503 <------- spelnr 96, 12cijfers totaal <werkt>

scancode spelnr pakketnr
011098420509--------> 11098420509 1 109842
011098430010--------> 11098430010 1 109843
01111168640250-----> 1111168640250 111 116864
01171072571203-----> 1171072571203 117 107257
01091234380251-----> 1091234380251 109 123438
961485450503--------> 961485450503 96 148545


ter verduidelijking

 

[wampier]

Dan kun je toch beter als tekst inlezen. deze uitleg veranderd niets aan het feit dat de nummers achter de nummers die je wil hebben blijkbaar altijd 4 cijfers zijn. Dus gewoon de rechter 10 pakken en dan daarvan de linker 6

met de VAL statement kun je text vervolgens nog omzetten. Dat maakt dit alles veel makkelijker. persoonlijk zou ik dit maken met regex, maar helaas heb ik nu geen excel dus kan ik het voorbeeld even niet laten zien

 

[Elsendoorn2134]

Joey,

Lees van het totaalnummer het gehele getal behalve de laatste 10 cijfers:
=WAARDE(DEEL(A1;1;LENGTE(A1)-10)) waarbij A1 de scancode is.

Veel Succes.

 

[joeyverveer]

Heel erg bedankt.......
Echter heb ik zelf niet de kennis dit stukje code te implementeren.
Heb het nog geprobeerd maar krijg compileerfout op compileerfout

Iemand die me kan helpen?

 

[wampier]

Elsendoorns oplossing is een formule, geen VBA (dus een oplossing die buiten VBA rechtstreeks in excel werkt)

De VBA equivalent is:

Target.Offset(0, 1).Value = val(mid(target,1,len(target)-10))

 

[joeyverveer]

SUPERRRRRR BEDANKT!

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 = Val(Mid(Target, 1, Len(Target) - 10))
    i = Application.WorksheetFunction.Match(spelnr, Sheets("Data").Range("A2:A" & Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row), 0)
    Target.Offset(0, 1).Value = Val(Mid(Target, 1, Len(Target) - 10))
    Target.Offset(0, 2).Value = Val(Mid(Target, Len(Target) - 9, 6))
    Target.Offset(0, 3).Value = Sheets("Data").Cells(1 + i, 2).Value
    Target.Offset(0, 4).Value = Sheets("Data").Cells(1 + i, 3).Value
    Target.Offset(0, 5).Value = Date
    Exit Sub
fout:
    MsgBox "Er is een spelnummer gescand wat nog niet in de lijst staat"
 End If
End Sub

EN hij werkt

 

[huijb]

@joeyverveer Onnodige quotes verwijderd. Wanneer je direct reageert op een reactie is het niet nodig om dat bericht te quoten. Onnodig quoten heet dat, hetgeen niet gewenst is.

 

[joeyverveer]

excuus, quote -> code