• 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.

Opgelost Fout Bij Verwijderen

Dit topic is als opgelost gemarkeerd
Status
Niet open voor verdere reacties.
M

marcel31281

Gebruiker
Lid geworden
30 okt 2015
Berichten
391
Ik kom net een fout in mijn bestand tegen en hoop dat jullie willen helpen dit op te lossen.
Met onderstaande code wordt alles keurig weggeschreven naar o.a. het blad "onderdelen" en het werkt verder prima.

Het probleem komt als ik een onderdeel welke verbruikt is verwijder op het blad 'overzicht', het aantal niet mee wijzigt op het blad 'onderdelen'.
Als ik bijvoorbeeld 8 accu's verbruikt heb op blad onderdelen en er vervolgens 1 verwijder op blad overzicht de aantal op 8 blijft staan terwijl dit 7 moet zijn.

Alvast bedankt,



Code: 
Private Sub OKButton_Click()
With Sheets("-overzicht-")
 Set X = .Range("g14:g" & [g800].End(xlUp).Row).Find(TextBox2.Value).Offset(, 3)
 
    For i = 2 To 5
    If Me("combobox" & i) <> "" Then
        If Me("textaant" & i) <> "" Then
            If X <> "" Then
                X.Value = X.Value & Chr(10) & Me("textaant" & i) & " x " & Me("combobox" & i).Value
             Else
                X.Value = Me("textaant" & i) & " x " & Me("combobox" & i).Value
            End If
        Else
            If X <> "" Then
                X.Value = X.Value & Chr(10) & Me("combobox" & i).Value
             Else
                X.Value = Me("combobox" & i).Value
            End If
        End If
    End If
   Next
    ActiveCell.Resize(, 5) = Array(TextBox1.Value, ComboBox1.Value, ComboBox9.Value, TextBox4.Value, TextBox5.Value)
 End With
 With Sheets("Onderdelen")
     For i = 2 To 6
    If Me("combobox" & i) <> "" Then
        If Me("textaant" & i) <> "" Then
            .[a1000].End(xlUp).Offset(1).Resize(, 3) = Array(Me("textaant" & i) & " x " & Me("combobox" & i).Value, TextBox2.Value, TextBox3.Value)
         Else
           .[a1000].End(xlUp).Offset(1).Resize(, 3) = Array(Me("combobox" & i).Value, TextBox2.Value, TextBox3.Value)
        End If
    End If
    Set onderdeel = .Range("e2:e" & .[e1000].End(xlUp).Row).Find(Me("combobox" & i).Value)
        If Not onderdeel Is Nothing Then
            onderdeel.Offset(, 1) = onderdeel.Offset(, 1).Value + Me("textaant" & i).Value
        Else
            .[e1000].End(xlUp).Offset(1).Resize(, 2) = Array(Me("combobox" & i).Value, Me("textaant" & i).Value)
        End If
        Next i
If TextBox1 <> "" Then
     ActiveCell = ActiveCell.Value
        With Sheets("Onderdelen").Cells(Rows.Count, 1).End(xlUp)
        End With
        
     Me.ComboBox1 = ""

     Me.ComboBox9 = ""
    
      
    
End If
End With
Unload Me
End Sub
 
Mooie code zo zonder enige context.
 
Omdat het originele bestand vrij groot is, heb ik geprobeerd een zo duidelijk mogelijk voorbeeld te maken.
 

Bijlagen

Ik dacht dat de fout in die code zat, maar volgens mij zit het in de code die achter “overzicht” zit. Zolang het aantal 1 is wordt deze keurig verwijderd, maar als het aantal hoger is dan werkt het niet meer.
 
Niet zo gek als je macro begint met:
Code: 
If Target.Count > 1 Then Exit Sub
 
Dat is de eerste regel in je macro en betekent dat als je meer dan 1 cel hebt geselecteerd de macro stopt.
 
Maar dat is niet het probleem wat ik hier boven beschrijf toch? Het gaat om de aantallen in kolom F op het blad onderdelen, deze aantallen moeten ook wijzigen als iets verwijderd word op blad Overzicht.
 
In bijlage de code die ik voor de grap via Chatgpt heb laten maken, echter lost dit het probleem helemaal niet op.
En kom ik ook geen stap verder :eek:😵‍💫

Maar misschien laat dit wel zien wat enigszins de bedoeling is

Alvast bedankt
 

Bijlagen

Beschrijf de stappen die je doet om het probleem te kunnen zien.
 
Ik kies in de userform die tevoorschijn komt als je in kolom K op een cel gaat staan een onderdeel in 1 van de comboboxen en voer daarnaast het aantal in en klik op opslaan.
Deze data wordt dan weggeschreven naar het blad overzicht en het blad onderdelen.
Op het blad onderdelen links in kolom A, B en C staat de ruwe data en die word netjes gesorteerd weergegeven in kolom E en F.

Als ik dan vervolgens een onderdeel moet verwijderen op het blad overzicht omdat de monteur een foutje heeft gemaakt, dan moet deze verwijderd worden in kolom A, B en C , en het totaal aantal in kolom F moet met het aantal naar beneden wat op het blad overzicht is verwijderd. Dus als daar 1x ... staat dan -1 of als er 4x.... staat dan -4 etc.

Nu blijft het aantal in F alleen maar oplopen en klopt de uiteindelijke score niet aan het einde
 
Zo ?, zelf maar volledig testen.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub
    
    If Not Intersect(Target, ListObjects(1).ListColumns(1).DataBodyRange) Is Nothing Then
        Target.Offset(, 1).Value = IIf(Target.Value = "v" Or Target.Value = "v", CDate(Date), "")
    End If
      
'Data op tab Gegevens verwijderen als op tab Overzicht een opmerking wordt verwijderd
Dim Serienummer As String
Dim AantalRegels As Integer
Dim i As Integer
Dim VerwijderdeRegels As Integer

    If Not Intersect(Target, ListObjects(1).ListColumns(9).DataBodyRange) Is Nothing Then
        
        If Target.Value = "" Then
            Serienummer = Range("G" & Target.Row).Value
            
            
            
            With Sheets("Onderdelen")
                AantalRegels = .Cells(.Rows.Count, "A").End(xlUp).Row
                
                For i = AantalRegels To 2 Step -1
                    If .Range("B" & i).Value = Serienummer Then
                        j = Len(.Range("A" & i))
                        Set c = .Range("E2:E1000").Find(Mid(.Range("A" & i), 5, j - 4), LookAt:=xlWhole)

                            If Not c Is Nothing Then
                                c.Offset(, 1) = c.Offset(, 1) - Val(Left(.Range("A" & i), 1)) '
                            End If
                        .Range("A" & i).Resize(, 3).Delete


                        VerwijderdeRegels = VerwijderdeRegels + 1
                    End If
                Next i
                
                'controle op 0 in kolom F
                AantalRegels = .Cells(.Rows.Count, "E").End(xlUp).Row
                For j = AantalRegels To 2 Step -1
                    If .Cells(j, "E").Offset(, 1).Value = 0 Then .Cells(j, "E").Resize(, 2).ClearContents
                Next
              
            End With

            
          
            
            If VerwijderdeRegels > 0 Then
                MsgBox Prompt:="Er zijn " & VerwijderdeRegels & " regels verwijderd op tab 'Onderdelen'.", _
                Buttons:=vbCritical + vbOKOnly, Title:="Verwijderde regels"
            End If
            
        End If
    
    End If

End Sub
 
Wat 'enigszins de bedoeling is' is niet te programmeren, wat 'precies de bedoeling is' wel.
Blijf daarom vooral je geluk beproeven met AI.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan