• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

probleem met uitbreiding VBA code

Status
Niet open voor verdere reacties.
A

AD1957

Verenigingslid
Lid geworden
27 feb 2016
Berichten
2.155
Ik heb onderaan onderstaande code toegevoegd zodat ik ook artikelen kan invoeren die niet in de artikellijst staan.


Code: 
 If Target.Column = 5 Then 'invullen totaal bruto als er geen code is (artikelen die niet in de artikellijst staan.)
        Target.Offset(, 1).Value = Target.Value * Target.Offset(0, -1).Value
    End If

Nu loop ik echter tegen het volgende probleem aan:
Als ik op een later tijdstip het aantal verander dan wordt de totaalbruto prijs niet aangepast maar het bedrag komt in totaal bruto loon te staan.
Ben nu al uren bezig maar krijg het niet opgelost.

Bekijk bijlage Begroting3.xlsb
 
Halve code levert halve antwoorden op. Waar staat deze code en wat zou deze code moeten doen?
 
kijk even onderaan in vba in het bijgevoegde bestand.
Ik kon eerst geen artikelen handmatig invoeren, door deze code lukt het wel.
Waarschijnlijk kan het ook op een andere manier.
Zelf kom ik er maar niet achter.
 
Geen idee wat het moet worden, maar misschien kan je met het aangevulde stukje code uit de voeten.
Code: 
If Target.Column = 5 Then 'invullen totaal bruto als er geen code is (artikelen die niet in de artikellijst staan.)
        Target.Offset(, 1).Value = Target.Value * Target.Offset(0, -1).Value
[COLOR=#0000ff]        ElseIf Target.Column = 4 Then[/COLOR]
[COLOR=#0000ff]        Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value[/COLOR]
    End If
 
Goede morgen Harry,
Jouw toevoeging aan de code was al een stuk op weg
zelf nog een stukje toegevoegd en het werkt perfect.
Code: 
If Target.Column = 5 Then 'invullen totaal bruto als er geen code is (artikelen die niet in de artikellijst staan.)
        Target.Offset(, 1).Value = Target.Value * Target.Offset(0, -1).Value
        ElseIf Target.Column = 4 Then
        Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value
            If Target.Offset(, -3).Value = Empty Then
            Target.Offset(, 4) = 0
            End If
    End If

Bedankt voor jouw reactie, voorbeeldbestand bijgevoegd.
Nu moet ik nog proberen om dmv. het toekennen van montageminuten in kolom 7 automatisch montagekosten toe te kennen in kolom 8.
Dit moet dan gebeuren als kolom 1 leeg is of het artikelnr. groter is dan 11.
Voor mij als vba beginneling zal het wel een hoop stres gaan opleveren, maar met hulp van dit forum gaat het zeker lukken.

Met vriendelijke groet,
AlbertBekijk bijlage Begroting3.xlsb
 
Ik zie nu pas dat dat stukje code er ook al in stond.

Ik heb de code even opnieuw opgebouwd zodat het overzichtelijker wordt.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range) 'invullen van cellen zonder formules
If Target.Cells.Count = 1 Then  ' Safety feature, only process when one cell is changed
 If Target.Row > 12 Then
   Application.EnableEvents = False


[COLOR=#0000ff]Select Case Target.Column[/COLOR]
            
     [COLOR=#0000ff]Case 1[/COLOR]
         If IsEmpty(Target) Then
             Range(Target, Target.Offset(, 9)).ClearContents
          Else
             Target.Offset(, 1).Value = Sheets("artikellijst").Columns(1).Find(Target.Value, , , xlWhole).Offset(, 6).Value 'artikelnummer
             Target.Offset(, 2).Value = Sheets("artikellijst").Columns(1).Find(Target.Value, , , xlWhole).Offset(, 1).Value 'omschrijving
             Target.Offset(, 4).Value = Sheets("artikellijst").Columns(1).Find(Target.Value, , , xlWhole).Offset(, 2).Value 'bruto prijs per stuk
          End If
         If Target.Value > 11 Then Target.Offset(, 8).Value = Sheets("artikellijst").Columns(1).Find(Target.Value, , , xlWhole).Offset(, 4).Value 'netto prijs per stuk


    [COLOR=#0000ff] Case 4[/COLOR]
          If Target.Offset(, -3).Value = Empty Then
             Target.Offset(, 4) = 0
           ElseIf Target.Offset(, -3).Value < 12 Then
             Target.Offset(, 4).Value = Target.Value * Target.Offset(, 1).Value
           Else
             Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value
             Target.Offset(, 6).Value = Target.Value * Target.Offset(, 5).Value
          End If
          
    [COLOR=#0000ff] Case 5  [/COLOR]    'invullen totaal bruto als er geen code is (artikelen die niet in de artikellijst staan.)
        Target.Offset(, 1).Value = Target.Value * Target.Offset(0, -1).Value
     [COLOR=#0000ff]End Select[/COLOR]
   Application.EnableEvents = True
    End If
 End If
End Sub

Ik denk dat je er nu wat gemakkelijker uitkomt om een stukje code toe te voegen wat je wilt bereiken.
 
was al een uurtje bezig met dat laatste probleem, tot nog toe lukt het niet.
ga het nu eens proberen met deze code.

Groet en dank,
Albert
 
Kleine aanpassing wat sneller verloopt en foutafhandeling ingebouwd.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range) 'invullen van cellen zonder formules
If Target.Cells.Count = 1 Then  ' Safety feature, only process when one cell is changed
 If Target.Row > 12 Then
   Application.EnableEvents = False

Select Case Target.Column
            
     Case 1
         If IsEmpty(Target) Then
             Range(Target, Target.Offset(, 9)).ClearContents
          Else
[COLOR=#0000ff]           set c =  Sheets("artikellijst").Columns(1).Find(Target.Value, , , xlWhole)
             if not c is nothing then[/COLOR]
[COLOR=#0000ff]                Target.Offset(, 1).Value = c.Offset(, 6).Value 'artikelnummer[/COLOR]
[COLOR=#0000ff]                Target.Offset(, 2).Value = c.Offset(, 1).Value 'omschrijving[/COLOR]
[COLOR=#0000ff]                Target.Offset(, 4).Value = c.Offset(, 2).Value 'bruto prijs per stuk[/COLOR]
             [COLOR=#0000ff]             [/COLOR][COLOR=#0000FF] If Target.Value > 11 Then Target.Offset(, 8).Value =c.Offset(, 4).Value 'netto prijs per stuk[/COLOR]
[COLOR=#0000ff]            End If[/COLOR]
        [COLOR="#FF0000"]    End if[/COLOR]

     Case 4
          If Target.Offset(, -3).Value = Empty Then
             Target.Offset(, 4) = 0
           ElseIf Target.Offset(, -3).Value < 12 Then
             Target.Offset(, 4).Value = Target.Value * Target.Offset(, 1).Value
           Else
             Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value
             Target.Offset(, 6).Value = Target.Value * Target.Offset(, 5).Value
          End If
          
     Case 5      'invullen totaal bruto als er geen code is (artikelen die niet in de artikellijst staan.)
        Target.Offset(, 1).Value = Target.Value * Target.Offset(0, -1).Value
     End Select
   Application.EnableEvents = True
    End If
 End If
End Sub
 
Laatst bewerkt:
krijg hier meteen een foutmelding "Case zonder select case"
de eerste code van jou werkte goed op een ding na.
in case 5 veranderd kolom 6 niet als ik kolom 4 verander
 
Ik heb de code aangepast (rode 'end if').
 
hoi Harry,
ik heb case 4 nog aangepast zie rode tekst.
Probleem was dat als er geen code in kolom 1 st. het totaal in kolom 5 niet veranderd als ik kolom 4 het aantal wiijzig.
Nu nog proberen dat ik die montageminuten in kolom 7 aan de gang krijg.:evil:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range) 'invullen van cellen zonder formules
If Target.Cells.Count = 1 Then  ' Safety feature, only process when one cell is changed
 If Target.Row > 12 Then
   Application.EnableEvents = False

Select Case Target.Column
            
     Case 1
         If IsEmpty(Target) Then
             Range(Target, Target.Offset(, 9)).ClearContents
          Else
           Set c = Sheets("artikellijst").Columns(1).Find(Target.Value, , , xlWhole)
             If Not c Is Nothing Then
                Target.Offset(, 1).Value = c.Offset(, 6).Value 'artikelnummer
                Target.Offset(, 2).Value = c.Offset(, 1).Value 'omschrijving
                Target.Offset(, 4).Value = c.Offset(, 2).Value 'bruto prijs per stuk
              If Target.Value > 11 Then Target.Offset(, 8).Value = c.Offset(, 4).Value 'netto prijs per stuk
            End If
            End If

     Case 4
          If Target.Offset(, -3).Value = Empty Then
             Target.Offset(, 4) = 0
             [COLOR="#FF0000"]Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value 'totaal bruto materiaal
             Target.Offset(, 6).Value = Target.Value * Target.Offset(, 5).Value 'totaal netto materiaal[/COLOR]
           ElseIf Target.Offset(, -3).Value < 12 Then
             Target.Offset(, 4).Value = Target.Value * Target.Offset(, 1).Value 'totaal bruto loon
           Else
             Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value 'totaal bruto materiaal
             Target.Offset(, 6).Value = Target.Value * Target.Offset(, 5).Value 'totaal netto materiaal
          End If
          
     Case 5      'invullen totaal bruto als er geen code is (artikelen die niet in de artikellijst staan.)
        Target.Offset(, 1).Value = Target.Value * Target.Offset(0, -1).Value
     End Select
   Application.EnableEvents = True
    End If
 End If
End Sub

Groet,
Albert
 
Goedemiddag Harry,
Die laatste code van jouw laat niets aan duidelijkheid te wensen.
Was voor mij een makkie om met de montageminuten in kolom 7 te werken.
enkele VBA regels toevoegen en "klaar is kees".
super duidelijke code.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range) 'invullen van cellen zonder formules
If Target.Cells.Count = 1 Then  ' Safety feature, only process when one cell is changed
 If Target.Row > 12 Then
   Application.EnableEvents = False

Select Case Target.Column
            
     Case 1
         If IsEmpty(Target) Then
             Range(Target, Target.Offset(, 9)).ClearContents
          Else
           Set c = Sheets("artikellijst").Columns(1).Find(Target.Value, , , xlWhole)
             If Not c Is Nothing Then
                Target.Offset(, 1).Value = c.Offset(, 6).Value 'artikelnummer
                Target.Offset(, 2).Value = c.Offset(, 1).Value 'omschrijving
                Target.Offset(, 4).Value = c.Offset(, 2).Value 'bruto prijs per stuk
              If Target.Value > 11 Then Target.Offset(, 8).Value = c.Offset(, 4).Value 'netto prijs per stuk
            End If
            End If

     Case 4
          If Target.Offset(, -3).Value = Empty Then
             Target.Offset(, 4) = 0
             Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value 'totaal bruto materiaal
             Target.Offset(, 6).Value = Target.Value * Target.Offset(, 5).Value 'totaal netto materiaal
             [COLOR="#FF0000"]Target.Offset(, 4).Value = Target.Value / 60 * Target.Offset(0, 3).Value * Range("J11").Value [/COLOR]'aanpassen bruto loon naar montageminuten als er geen code ingevuld
           ElseIf Target.Offset(, -3).Value < 12 Then
             Target.Offset(, 4).Value = Target.Value * Target.Offset(, 1).Value 'totaal bruto loon
           Else
             Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value 'totaal bruto materiaal
             Target.Offset(, 6).Value = Target.Value * Target.Offset(, 5).Value 'totaal netto materiaal
             [COLOR="#FF0000"]Target.Offset(, 4).Value = Target.Value / 60 * Target.Offset(0, 3).Value * Range("J11").Value [/COLOR]'aanpassen bruto loon naar montageminuten als er code groter 11
          End If
          
     Case 5      'invullen totaal bruto als er geen code is (artikelen die niet in de artikellijst staan.)
            Target.Offset(, 1).Value = Target.Value * Target.Offset(0, -1).Value
        
    [COLOR="#FF0000"] Case 7
            Target.Offset(, 1).Value = Target.Value / 60 * Target.Offset(0, -3).Value * Range("J11").Value[/COLOR]
          
End Select
     
     
   Application.EnableEvents = True
    End If
 End If
End Sub

hartelijk dank,
Groet,
Albert
 
toch nog een vraagje.
is het mogelijk om met een opdrachtknop tijdelijk regels uit de code te verwijderen.
na afsluiten moeten de regels dan weer worden teruggeplaatst.
 
Volgens mij niet. Met welk doel wil je dit? Zet ergens een vlaggetje die bepaalt of een bepaald gedeelte van de code wel of niet uitgevoerd moet worden.
 
doel: 1 van de gebruikers vindt het ontzettend onoverzichtelijk om met montageminuten te werken.
Is er nog een van de oude stempel.
Ik zou dus de rood gemerkte regel tijdelijk willen verwijderen (opdrachtknop)
Na afsluiten moet deze regel weer worden teruggeplaatst.


Code: 
Private Sub Worksheet_Change(ByVal Target As Range) 'invullen van cellen zonder formules
If Target.Cells.Count = 1 Then  ' Safety feature, only process when one cell is changed
 If Target.Row > 12 Then
   Application.EnableEvents = False

Select Case Target.Column
            
     Case 1
         If IsEmpty(Target) Then
             Range(Target, Target.Offset(, 9)).ClearContents
          Else
           Set c = Sheets("artikellijst").Columns(1).Find(Target.Value, , , xlWhole)
             If Not c Is Nothing Then
                Target.Offset(, 1).Value = c.Offset(, 6).Value 'artikelnummer
                Target.Offset(, 2).Value = c.Offset(, 1).Value 'omschrijving
                Target.Offset(, 4).Value = c.Offset(, 2).Value 'bruto prijs per stuk
               [COLOR="#FF0000"] Target.Offset(, 6).Value = c.Offset(, 5).Value 'montageminuten per artikel[/COLOR]
              If Target.Value > 11 Then Target.Offset(, 8).Value = c.Offset(, 4).Value 'netto prijs per stuk
            End If
            End If

     Case 4
          If Target.Offset(, -3).Value = Empty Then
             Target.Offset(, 4) = 0
             Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value 'totaal bruto materiaal
             Target.Offset(, 6).Value = Target.Value * Target.Offset(, 5).Value 'totaal netto materiaal
             Target.Offset(, 4).Value = Target.Value / 60 * Target.Offset(0, 3).Value * Range("J11").Value 'aanpassen bruto loon naar montageminuten als er geen code ingevuld
           ElseIf Target.Offset(, -3).Value < 12 Then
             Target.Offset(, 4).Value = Target.Value * Target.Offset(, 1).Value 'totaal bruto loon
           Else
             Target.Offset(, 2).Value = Target.Value * Target.Offset(, 1).Value 'totaal bruto materiaal
             Target.Offset(, 6).Value = Target.Value * Target.Offset(, 5).Value 'totaal netto materiaal
             Target.Offset(, 4).Value = Target.Value / 60 * Target.Offset(0, 3).Value * Range("J11").Value 'aanpassen bruto loon naar montageminuten als er code groter 11
          End If
          
     Case 5      'invullen totaal bruto als er geen code is (artikelen die niet in de artikellijst staan.)
            Target.Offset(, 1).Value = Target.Value * Target.Offset(0, -1).Value
        
     Case 7
            Target.Offset(, 1).Value = Target.Value / 60 * Target.Offset(0, -3).Value * Range("J11").Value
          
End Select
     
     
   Application.EnableEvents = True
    End If
 End If
End Sub
 
Code: 
Sub zet_apostrof()
With ThisWorkbook.VBProject.VBComponents("blad1").CodeModule
 .ReplaceLine 20, "'" & .Lines(20, 1)
End With
End Sub


Sub verwijder_apostrof()
With ThisWorkbook.VBProject.VBComponents("blad1").CodeModule
 .ReplaceLine 20, Mid(.Lines(20, 1), 2)
End With
End Sub
 
Hallo Harry,
Perfecte code.
Ben alleen bang dat als ik in de toekomst ook maar iets verander in de totale VBA-code (boven regel 20!!!!)
niet begrijp waarom de code niet meer werkt. Dat zou dan weer uren zoeken worden.
Heb inmiddels een elegante oplossing. Gewoon een werkblad toegevoegd ( BEGROTING zonder minuten)
Ik ga nu een beetje stoeien met de totale code in andere werkbladen. Voornamelijk met "select case target.column"
Deze code maakt alles veel duidelijker leesbaar.

Groet en dank,
Albert

(p.s. ik ga de vraag als opgelost markeren)
 
Laatst bewerkt:
Als ieder een eigen Pc heeft kan het ook anders.
Stel dat die van de oude stempel z'n Pc gebruikersnaam Albert is.

Of zijn Excel gebruikersnaam (application.name) is Albert.

Code: 
Else
           Set c = Sheets("artikellijst").Columns(1).Find(Target.Value, , , xlWhole)
             If Not c Is Nothing Then
                Target.Offset(, 1).Value = c.Offset(, 6).Value 'artikelnummer
                Target.Offset(, 2).Value = c.Offset(, 1).Value 'omschrijving
                Target.Offset(, 4).Value = c.Offset(, 2).Value 'bruto prijs per stuk[COLOR=#ff0000]                
                if environ("UserName") <> "Albert" then[/COLOR] Target.Offset(, 6).Value = c.Offset(, 5).Value 'montageminuten per artikel  Pc gebruikersnaam
[COLOR=#ff0000] 'Of:          if application.name <> "Albert" then[/COLOR] Target.Offset(, 6).Value = c.Offset(, 5).Value 'montageminuten per artikel        EXcel gebruikersnaam
              If Target.Value > 11 Then Target.Offset(, 8).Value = c.Offset(, 4).Value 'netto prijs per stuk
            End If
            End If
 
zal eens kijken of ik hiermee iets kan, het is nooit weg om deze code eens te testen.
In ieder geval zal het weer leerzaam zijn.

GRoet,
Albert
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan