VBA is te lang

Spongebop · Gisteren om 17:27

#beginner die wat wil leren.

Na een tijdje weg geweest probeer ik weer even iets te schrijven.

Ik probeer een kassa te maken maar ik loop tegen een probleem op.
Misschien dat iemand mee wil denken (het is wel even uitzoeken denk ik).

Hieronder heb ik een VBA code die erg lang is en die, zoals ik het nu schrijf, nog langer moet worden.
Dit zit onder commandbutton1 (zie bestand, knop links boven).
Wat de bedoeling is.
Als je op de knop drukt dan moet het systeem kijken of cel op sheets Bon cel a2 leeg is.
Is die leeg dan moet hij uit sheets kassa het betreffende voorwerp en prijs kopiëren naar de bon.
Mocht hij er al staan dan moet het aantal omhoog.
Mocht er een ander voorwerp staan dan moet hij op de bon 1 regel omlaag.

Nu ben ik het zo aan het schrijven dat ik onder elke knop (voorwerp) 60 voorwerpen moet beschrijven en 25 keer dat het systeem moet kijken of er iets staat op de bon.

Weet iemand hoe ik dit kan overschrijven? Onderstaande verkorten maar dat het heel makkelijk onder elke knop gezet kan worden.

Code:

Private Sub CommandButton1_Click()
terug:
    'naam geven en cel in geheugen plaatsen
                Set cel1 = Sheets("BON").Range("B2") ' Vervang "Blad1" en "A1" door je eigen waarden
                Set cel2 = Sheets("Kassa").Range("B3") ' Vervang "Blad1" en "B1" door je eigen waarden
    'Vergelijk de waarden van de cellen
                If cel1.Value = cel2.Value Then
    ' Voer acties uit als de cellen gelijk zijn
    'optellen
                With Sheets("Bon")
                nummer = Right(.Range("C2").Value, 4)
                If nummer = "" Then nummer = 0
                nummer = Val(nummer) + 1
                .Range("C2").Value = Format(nummer, "00000")
            End With
    'BON 1e rij aan
    CommandButton67.Caption = Sheets("BON").Range("B2")
    CommandButton68.Caption = Sheets("BON").Range("C2")
    TextBox2.Text = Format(Worksheets("BON").Range("E2").Value, "€ #,##0.00")
   CommandButton67.Visible = True
    CommandButton68.Visible = True
    TextBox2.Visible = True
        
            GoTo klaar
    'als cellen niet gelijk zijn ga dan verder
        Else
    'als cel niet leeg is
                If Sheets("BON").Range("B2").Value <> "" Then GoTo verder1
          
    ' Voer acties uit als de cellen niet gelijk zijn
    'zet voorwerp en prijs in bon
            Sheets("BON").Range("B2") = Sheets("Kassa").Range("B3")
            Sheets("BON").Range("D2") = Sheets("Kassa").Range("C3")
    'optellen
    With Sheets("Bon")
    nummer = Right(.Range("C2").Value, 4)
    If nummer = "" Then nummer = 0
    nummer = Val(nummer) + 1
    .Range("C2").Value = Format(nummer, "00000")
    End With
    'BON 1e rij aan
    CommandButton67.Caption = Sheets("BON").Range("B2")
    CommandButton68.Caption = Sheets("BON").Range("C2")
    TextBox2.Text = Format(Worksheets("BON").Range("E2").Value, "€ #,##0.00")
   CommandButton67.Visible = True
    CommandButton68.Visible = True
    TextBox2.Visible = True
    GoTo klaar:
  End If
'-------------------------
verder1:
    'naam geven en cel in geheugen plaatsen
                Set cel1 = Sheets("BON").Range("B3") ' Vervang "Blad1" en "A1" door je eigen waarden
                Set cel2 = Sheets("Kassa").Range("B3") ' Vervang "Blad1" en "B1" door je eigen waarden
    'Vergelijk de waarden van de cellen
                If cel1.Value = cel2.Value Then
    ' Voer acties uit als de cellen gelijk zijn
    'optellen
                With Sheets("Bon")
                nummer = Right(.Range("C3").Value, 4)
                If nummer = "" Then nummer = 0
                nummer = Val(nummer) + 1
                .Range("C3").Value = Format(nummer, "00000")
            End With
    'BON 2e rij aan
    
    CommandButton72.Visible = True
    CommandButton71.Visible = True
    TextBox7.Visible = True
    CommandButton72.Caption = Sheets("BON").Range("B3")
    CommandButton71.Caption = Sheets("BON").Range("C3")
    TextBox7.Text = Format(Worksheets("BON").Range("E3").Value, "€ #,##0.00")
    
                'als cellen niet gelijk zijn ga dan verder
        Else
    'als cel niet leeg is
                If Sheets("BON").Range("B3").Value <> "" Then GoTo verder2
          
    ' Voer acties uit als de cellen niet gelijk zijn
    'zet voorwerp en prijs in bon
            Sheets("BON").Range("B3") = Sheets("Kassa").Range("B3")
            Sheets("BON").Range("D3") = Sheets("Kassa").Range("C3")
    'optellen
    With Sheets("Bon")
    nummer = Right(.Range("C3").Value, 4)
    If nummer = "" Then nummer = 0
    nummer = Val(nummer) + 1
    .Range("C3").Value = Format(nummer, "00000")
    End With
    'BON 2e rij aan
    
    CommandButton72.Visible = True
    CommandButton71.Visible = True
    TextBox7.Visible = True
    CommandButton72.Caption = Sheets("BON").Range("B3")
    CommandButton71.Caption = Sheets("BON").Range("C3")
    TextBox7.Text = Format(Worksheets("BON").Range("E3").Value, "€ #,##0.00")
    
    
    GoTo klaar:
  End If
'-------------------------
verder2:
    'naam geven en cel in geheugen plaatsen
                Set cel1 = Sheets("BON").Range("B4") ' Vervang "Blad1" en "A1" door je eigen waarden
                Set cel2 = Sheets("Kassa").Range("B3") ' Vervang "Blad1" en "B1" door je eigen waarden
    'Vergelijk de waarden van de cellen
                If cel1.Value = cel2.Value Then
    ' Voer acties uit als de cellen gelijk zijn
    'optellen
                With Sheets("Bon")
                nummer = Right(.Range("C4").Value, 4)
                If nummer = "" Then nummer = 0
                nummer = Val(nummer) + 1
                .Range("C4").Value = Format(nummer, "00000")
            End With
    
    'BON 3e rij
    CommandButton75.Caption = Sheets("BON").Range("B4")
    CommandButton74.Caption = Sheets("BON").Range("C4")
    TextBox6.Text = Format(Worksheets("BON").Range("E4").Value, "€ #,##0.00")
    CommandButton75.Visible = True
    CommandButton74.Visible = True
    TextBox6.Visible = True
    
                'als cellen niet gelijk zijn ga dan verder
        Else
    'als cel niet leeg is
                If Sheets("BON").Range("B4").Value <> "" Then GoTo verder3
          
    ' Voer acties uit als de cellen niet gelijk zijn
    'zet voorwerp en prijs in bon
            Sheets("BON").Range("B4") = Sheets("Kassa").Range("B3")
            Sheets("BON").Range("D4") = Sheets("Kassa").Range("C3")
    'optellen
    With Sheets("Bon")
    nummer = Right(.Range("C4").Value, 4)
    If nummer = "" Then nummer = 0
    nummer = Val(nummer) + 1
    .Range("C4").Value = Format(nummer, "00000")
    End With

    'BON 3e rij
    CommandButton75.Caption = Sheets("BON").Range("B4")
    CommandButton74.Caption = Sheets("BON").Range("C4")
    TextBox6.Text = Format(Worksheets("BON").Range("E4").Value, "€ #,##0.00")
    CommandButton75.Visible = True
    CommandButton74.Visible = True
    TextBox6.Visible = True
    
    
    GoTo klaar:
  End If
'---------------
verder3:

klaar:
    
    
    'TOTAAL
    CommandButton63.Caption = Format(Worksheets("BON").Range("E40").Value, "€ #,##0.00")
    CommandButton63.Visible = True
    TextBox24.Visible = True
    KASSA.Hide
  
    KASSA.Show
    


End Sub

peter59 · Gisteren om 19:22

Bekijk deze eens.
Hier kan je naar hartenlust mee oefenen.

AlexCEL · Gisteren om 20:41

Geen VBA-expert dus ik heb het aan ChatGPT gevraagd. Hieronder het antwoord. Als je nog wensen hebt kan ChatGPT je ook helpen de code aan te passen.

Code:

Private Sub CommandButton1_Click()
    Dim i As Long
    For i = 2 To 4
        If VerwerkBonRij(i) Then Exit For
    Next
    With CommandButton63
        .Caption = Format(Sheets("BON").Range("E40").Value, "€ #,##0.00")
        .Visible = True
    End With
    TextBox24.Visible = True
    KASSA.Hide: KASSA.Show
End Sub

Private Function VerwerkBonRij(rij As Long) As Boolean
    Dim bon As Worksheet, kas As Worksheet
    Set bon = Sheets("BON"): Set kas = Sheets("Kassa")

    Dim celBon As Range: Set celBon = bon.Cells(rij, 2)
    Dim celKas As Range: Set celKas = kas.Range("B3")

    If celBon.Value = celKas.Value Or celBon.Value = "" Then
        If celBon.Value = "" Then
            celBon.Value = celKas.Value
            bon.Cells(rij, 4).Value = kas.Range("C3").Value
        End If
        Dim nr As Long
        nr = Val(Right(bon.Cells(rij, 3).Value, 4)) + 1
        bon.Cells(rij, 3).Value = Format(nr, "00000")

        Dim btn1$, btn2$, txt$
        Select Case rij
            Case 2: btn1 = "CommandButton67": btn2 = "CommandButton68": txt = "TextBox2"
            Case 3: btn1 = "CommandButton72": btn2 = "CommandButton71": txt = "TextBox7"
            Case 4: btn1 = "CommandButton75": btn2 = "CommandButton74": txt = "TextBox6"
        End Select

        With Me
            .Controls(btn1).Caption = celBon.Value
            .Controls(btn2).Caption = bon.Cells(rij, 3).Value
            .Controls(txt).Text = Format(bon.Cells(rij, 5).Value, "€ #,##0.00")
            .Controls(btn1).Visible = True
            .Controls(btn2).Visible = True
            .Controls(txt).Visible = True
        End With
        VerwerkBonRij = True
    End If
End Function

AHulpje · Gisteren om 21:15

Om in je eigen stijl te blijven, een beginnetje:

RogerS · Vandaag om 09:23

Gebruik alsjeblieft geen GOTO. Dat is echt iets uit de vorige eeuw en totaal overbodig en onhandig

emields · Vandaag om 09:34

Al was het maar om te tonen dat er veel wegen naar Rome leiden.

Warme bakkertje · Vandaag om 11:45

@emields
Voor 72 knoppen is dit totaal onwerkbaar.
Voor repetitieve code gebruik je 1 basisblok met de nodige argumenten en een verwijzing per knop naar die basiscode. zoals AHulpje gedaan heeft.
Of beter nog, gebruik een Class event. Laad bij het openen van het formulier alle CommandButtons in een collectie en link ze aan de code in het Class event.

snb · Vandaag om 12:07

Het begint natuurlijk al bij de basis:: 1 keer lezen ipv 72 keer

Code:

Private Sub UserForm_Initialize()
   sn=Blad1.cells(1).currentregion
   
   For j = 0 To 71
      with Me(format(j, "\C_00"))
         .Caption = sn(j+2,1)
        .Tag=sn(j+2,2)
      End With
   Next
End Sub

VBA is te lang

Spongebop

Gebruiker

Bijlagen

peter59

Terugkerende gebruiker

AlexCEL

Meubilair

AHulpje

Terugkerende gebruiker

Bijlagen

RogerS

Meubilair

emields

Terugkerende gebruiker

Bijlagen

Warme bakkertje

Meubilair

snb

Verenigingslid

Nieuwste berichten

Wij waarderen jouw privacy