VBA Alphabet laten invullen

[gast0667]

Hoi,
Kan VBA ook het alphabet invullen, bijvoorbeeld:

Bonnr. 6
Bonnr. 6A
Bonnr. 6B
Bonnr. 6C
Bonnr. --------> En hier dan door VBA 6D in laten vullen !
etc.


Hoor het graag.
Alvast bedankt.

 

[ReneDirks]

Hier zul je zelf iets voor moeten schrijven:

strBonNr = iCounter & chr(65 + iSubNr)

waarbij iSubNr van 0 tot 25 loopt (allemaal hoodletters)

 

[gast0667]

Hier zul je zelf iets voor moeten schrijven:

strBonNr = iCounter & chr(65 + iSubNr)

waarbij iSubNr van 0 tot 25 loopt (allemaal hoodletters)

Begrijp het nog niet helemaal. Hoe zet ik die code erin dan ?

 

[ReneDirks]

In VBA. Maar waar gebruik je het voor? Access? Excel? Word? En wat ga je er mee doen? Ordernummers of zo?

 

[gast0667]

Het word gebruikt in excel.

Kolom A Kolom B
Bonnr. Omschrijving
6 voorbeeld 1
6A voorbeeld 2
6B voorbeeld 3
7 voorbeeld 4
7A voorbeeld 5


Wil nu dat VBA een nieuwe bon invoegd. Het bonnummer is 6 dus moet VBA tussen 6B en 7 een nieuwe regel invoegen en deze nieuwe bon 6C noemen.

Het is me redelijk gelukt dat VBA kan zien waar de bonnummers staan en waar een nieuwe regel ingevuld moet worden, echter het lukt niet dat VBA Zelf 6C invult in kolom A.

 

[ReneDirks]

Ik heb 'm om te testen even in een public sub gezet, je kunt de code uiteraard gewoon in je huidige code plaatsen, dan heb je dus het object ws ook niet nodig. Verder heb ik geen code geschreven om de juiste cell te zoeken, omdat je zei dat je die al hebt. Ik ga dus domweg uit van cel A5 waar de info in staat, maar dat maakt voor het principe niet uit.

Public Sub NewBonnr()
  Dim r As Range
  Dim ws As Worksheet
  
  Dim strNewNr As String
  Dim strNr As String
  Dim strExt As String
  Dim iCharValue As Integer
  
    Set ws = Me.Worksheets("Sheet1")
  
    'ik ga ervan uit dat dit je geselecteerde cell is
    'maw cel A5 wijst naar Bon 6B als je een nieuwe 6
    'wilt toevoegen - (die dus 6C moet worden)
    Set r = ws.Cells(5, 1)
    
    strNr = Val(r.Text)
    If IsNumeric(r.Text) Then
       'next letter will be "A"
       strExt = "A"
    Else
        
        iCharValue = Asc(Right(r.Text, 1))
        If iCharValue >= Asc("Z") Then
            Err.Raise vbError + 1, "NewBonNr", "Geen bonnummers meer beschikbaar"
        Else
            strExt = Chr(iCharValue + 1)
        End If
    End If
    strNewNr = strNr & strExt
    'strNewNr bevat nu de nieuwe string, die kun je weer in de range zetten.
End Sub

 

[gast0667]

Helaas kan er niet echt wijs uit worden. VBA geeft telkens fouten aan met name bij 'ws' en 'Me.worksheets'. Dit is de code die ik nu gebruik

Private Sub CommandButton1_Click()

SubNr = [V11]  'Dit is de door gebruiker aangegeven subnummer zoals 6 in (LET OP) Worksheet(2).

Worksheets(1).Activate  'In dit blad dient gezocht en gewerkt te worden.
With Worksheets(1).Range("A1:A500")     'Bereik waarin gezocht wordt.
    Set a = .Find(SubNr, LookIn:=xlValues, LookAt:=xlPart, searchdirection:=xlPrevious)
        
    If Not a Is Nothing Then
            firstaddress = a.Address
        Do
            Regel = a.Row
            
            If Worksheets(1).Cells(Regel, "E") = "" Then    'Voorwaarde van zoeken, deze kolom dient leeg te zijn op dit regelniveau.
                Worksheets(1).Cells(Regel, "E").Select
                EndLoop = True
                Exit Do
            Else
                Set a = .FindNext(a)
                Regel = a.Row
            End If
    
        Loop Until EndLoop = True Or a.Address = firstaddress
    End If
    
If a.Address = firstaddress And Not Worksheets(1).Cells(Regel, "E") = "" Then
    MsgBox "Alle sub-regels zijn vol."
    Worksheets(1).Cells(Regel, "E").Select
    NieuwRegel = InputBox("Geef nieuw regelnummer aan !", "Nieuw regelnummer aanmaken", a.Row)
    
    If NieuwRegel > 0 And Not NieuwRegel = "" Then
        Worksheets(1).Rows(NieuwRegel + 1).Insert shift:=xlDown
        Worksheets(1).Cells(NieuwRegel + 1, "E").Select
        MsgBox "Regel is ingevoerd", vbOKOnly, "Ingevoerde regel is " & NieuwRegel + 1
    ElseIf NieuwRegel = "" Then
        MsgBox "Afgebroken"
    End If

End If
End With

EndLoop = False

End Sub

Kan jij aangeven waar en hoe de code ingeplakt dient te worden ?
(Zoals je kan zien ben ik niet bepaald een VBA expert/gevorderde)

Bedankt voor het helpen.