• 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 Meerdere voorwaarden

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

mvdvlist

Gebruiker
Lid geworden
16 dec 2016
Berichten
887
Ik heb een kalender gemaakt.
Bij wissen wil ik graag dat hij 4 voorwaarden meeneemt. ID, datum, voorwaarde drie en voorwaarde vier.
Tot drie voorwaarden werkt het, daarna krijg ik een foutmelding "Typen komen niet met elkaar overeen".

Ik gebruik deze code met drie
Code: 
Private Sub CommandButton2_Click()
  Blad1.Unprotect
' On Error Resume Next
    If MsgBox("Weet je zeker dat je deze afspraak wilt verwijderen?", vbQuestion & vbYesNo, "Bevestig het verwijderen") = vbYes Then

 Blad2.Range("A:A").Find (ListBox1.Column(0)) And Blad2.Range("B:B").Find(ListBox1.Column(1)) And Blad2.Range("C:C").Find(ListBox1.Column(2)) .EntireRow.Delete
    End If
          ActiveSheet.ListBox1.List = Blad2.ListObjects(1).DataBodyRange.Value
       Range("AJ2:AJ4").ClearContents
          SORTEREN
          ActiveSheet.ListBox1.List = Blad2.ListObjects(1).DataBodyRange.Value
Blad1.Protect

Dat werkt prima maar ik wil er iets aan toevoegen, namelijk voorwaarde vier. Dat zou dan zo moeten worden:

Code: 
Private Sub CommandButton2_Click()
  Blad1.Unprotect
' On Error Resume Next
    If MsgBox("Weet je zeker dat je deze afspraak wilt verwijderen?", vbQuestion & vbYesNo, "Bevestig het verwijderen") = vbYes Then

 Blad2.Range("A:A").Find (ListBox1.Column(0)) And Blad2.Range("B:B").Find(ListBox1.Column(1)) And Blad2.Range("C:C").Find(ListBox1.Column(2)) And Blad2.Range("D:D").Find(ListBox1.Column(3)).EntireRow.Delete
    End If
          ActiveSheet.ListBox1.List = Blad2.ListObjects(1).DataBodyRange.Value
       Range("AJ2:AJ4").ClearContents
          SORTEREN
          ActiveSheet.ListBox1.List = Blad2.ListObjects(1).DataBodyRange.Value
Blad1.Protect

Ik heb alle cel eigenschappen gecontroleerd, maar krijg dit niet werkend,. maar dit is soms nodig bijvoorbeeld als ik een afspraak heb met als voorwaarde drie een naam en voorwaarde 4 een tijd (geplaatst als tekst, dus bv vrijdag 22 juni )

Document is toegevoegd. Gegevens zijn fake..
 

Bijlagen

Splits de Find acties eens op en ken hun resultaten toe aan een variabele, dan kan je zien waar het mis gaat.
 
In voorwaarde 4, dus cel AJ4.
Ik dacht dat er misschien een maximum zat aan de voorwaarden... Het zou geen probleem zijn om het te doen met een listindex maar dan gaat het fout als de listbox gefilterd is de tabel niet..
 
Sorry, mijn reactie in bericht #4 slaat nergens op.
 
Ik snap die delete constructie niet. Als ID, datum, persoon en afspraak gevonden worden in BLAD2 dan wil je de rij verwijderen. En als die items nu eens in verschillende rijen gevonden worden? Je zult dus moeten controleren of die vier items gevonden worden én in dezelfde rij staan.

Mij lijkt het trouwens voldoende om alleen op ID te zoeken, als het goed is is die uniek.
 
Code: 
Blad2.ListObjects(1).ListRows(ListBox1.ListIndex + 1).Range.Delete
Of.
Code: 
Blad2.ListObjects(1).DataBodyRange(ListBox1.ListIndex + 1, 1).EntireRow.Delete
 
als je nu een bepaalde lijn in je listbox aanklikt en dan "wis afspraak"
 

Bijlagen

@cow18 , Waarom die lus met 'selected(i)' als je maar een kunt selecteren.

Die ene regel die ik hanteer is toch voldoende, die overigens nog weer iets korter kan (heb de "End If" maar gelaten anders wordt het wel een hele lange oneliner}.
Code: 
If MsgBox("Weet je zeker dat je deze afspraak wilt verwijderen?", vbQuestion & vbYesNo, "Bevestig het verwijderen") = vbYes Then
      Blad2.ListObjects(1).ListRows(ListBox1.ListIndex + 1).Delete
    End If
 
Dank je HSV.
Deze mogelijkheid had ik al toegepast, maar als ik met de zoekfunctie dubbelklik op datum de listbox filter gaat het mis, omdat de tabel dan niet gefilterd wordt. Maar ik denk dat Ahulpje wel gelijk heeft. Zoeken alleen op ID. Dan moet ik alleen een module toevoegen waardoor ik er zeker van kan zijn dat er geen dubbele waarden in die kolom A voorkomen. Maar dat is simpel op te lossen. Ik ga dit proberen.
 
Als ik bv twee afspraken maak, bv test 1 en test 2 op dezelfde datum en ik vul de listbox met de afspraken van die datum, zoals boven gezegd, dan gaat het wissen helaas nog steeds mis, Cow18.
Terwijl hij toch echt in de msgbox aangeeft dat het om de juiste regel gaat. Vreemd...Dus alleen in een ONGEFILTERDE tabel en GEFILTERDE listbox gaat het fout...Mogelijk als ik er op een of andere manier voor kan zorgen dat bij filteren van de listbox ook de tabel gefilterd wordt...Weer even brainstormen...
 
Ahulpje, jou oplossing werkt idd altijd. Logisch eigenlijk, met een unieke sleutel.

De code is nu heel simpel:
Code: 
Private Sub CommandButton2_Click()
  Blad1.Unprotect
' On Error Resume Next
    If MsgBox("Weet je zeker dat je deze afspraak wilt verwijderen?", vbQuestion & vbYesNo, "Bevestig het        verwijderen") = vbYes Then

 Blad2.Range("A:A").Find(ListBox1.Column(0)).EntireRow.Delete
    End If
          ActiveSheet.ListBox1.List = Blad2.ListObjects(1).DataBodyRange.Value
       Range("AJ2:AJ4").ClearContents
          SORTEREN
          ActiveSheet.ListBox1.List = Blad2.ListObjects(1).DataBodyRange.Value
Blad1.Protect

End Sub

Bedankt allemaal voor het meedenken.
Ik wacht nog even op eventuele reacties en dan sluit ik dit topic.
Ik heb het aangepaste document bijgevoegd...met ID_UNIEK module...
 

Bijlagen

Code: 
 If .List(i, 1) = cDBR(r, 2).Value2 And .List(i, 2) = cDBR(r, 3).Value And .List(i, 3) = cDBR(r, 4).Value Then     'de andere 3 zijn ook gelijk
        LO.ListRows(r).Delete
 Else
tja, er stond een foutje in, het was listrows(r).delete
 

Bijlagen

Nog een paar kleinigheden en schoonheidsfoutjes in de versie van #13:
  • Spatie weer tussengevoegd bij RemoveItem.
  • Buttons logische namen gegeven.
  • Layout van de VBAcode strak getrokken.
  • Een paar grijze vlakjes tussen de kalendermaanden verwijderd.
  • Worksheet_BeforeRightClick uitgeschakeld.
  • Overbodige modules en formulier verwijderd.
  • Overbodige validatiemessages verwijderd.
 

Bijlagen

Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan