lus vereenvoudigen

[Bosch_Guido]

Ik gebruik de volgende lus om een bereik te doorzoeken. Eigenlijk wil ik dat de lus niet in meerdere lussen maar in één lus wordt doorgelopen. Het is namelijk zo dat ik de waarde wil verwijderen als deze de waarde van A9 heeft, maar ook als hij de waarde van A10 heeft. Kan ik dit makkelijker aan elkaar binden? Ik heb gemerkt dat mijn macro hier heel erg traag van wordt. De range is altijd hetzelfde. Alvast bedankt. :thumb:

For Each c In Sheets("Cursusaanbod").Range("H4:H25")
If c = Range("A9").Value Then
c.Delete Shift:=xlUp
End If
Next c

For Each c In Sheets("Cursusaanbod").Range("H4:H25")
If c = Range("A10").Value Then
c.Delete Shift:=xlUp
End If
Next c

 

[jheesterbeek]

combineren met or:

For Each c In Sheets("Cursusaanbod").Range("H4:H25")
If c = Range("A9").Value or c = Range("A10").Value Then
c.Delete Shift:=xlUp
End If
Next c

 

[Bosch_Guido]

ik wist wel dat het niet al te moeilijk kon zijn...
thnx

 

[LucB]

Delete Rows

Probeer dit eens.

With Sheets("Cursusaanbod")
For Each c In Range("H4:H25")
If c.Value = Range("A9").Value Or Range("A10").Value Then
c.Delete Shift:=xlUp
End If
Next c
End With

 

[Bosch_Guido]

met de laatste oplossing werkt het niet meer, er worden geen waarden verwijderd terwijl ze er wel staan! In Range H staat een gedefinieerde naam, waarvan de "naam" staat in H3 en de waarden in =VERSCHUIVING(Cursusaanbod!$H$3;0;0;AANTALARG(Cursusaanbod!$H:$H))

Maar volgens mij heeft dit geen invloed toch?

Ik snap het niet.. :S

Guido

 

[LucB]

delete rows

Guido

Zo dan.

With Sheets("Cursusaanbod")
For Each c In Range("H4:H25")
If c.Value = Range("A9").Value Or c.Value = Range("A10").Value Then
c.Delete Shift:=xlUp
End If
Next c
End With

 

[Bosch_Guido]

ook niet..

 

[Bosch_Guido]

Deze code gebruik ik om de lijst te maken...

If Range("H11") = True Then
Rows("14:65")..EntireRow.Hidden = False
Range("H4:H11") = True
Range("B11").Select

With Sheets("Cursusaanbod")
x = .Cells(Rows.Count, "H").End(xlUp).Row
End With

Range("A4:A10").Copy Destination:=Sheets("Cursusaanbod").Range("H4:H10")

Zit hier dan ergens een foutje in?

 

[LucB]

If Range("H11") = True Then
Rows("14:65")..EntireRow.Hidden = False
Range("H4:H11") = True 'Dit kan dacht ik niet zo. Elke cel afzonderlijk op True zetten.
Range("B11").Select

With Sheets("Cursusaanbod")
x = .Cells(Rows.Count, "H").End(xlUp).Row 'gebruik je x ergens?
End With

Range("A4:A10").Copy Destination:=Sheets("Cursusaanbod").Range("H4:H10")
'Moet zijn:Range("H4")

 

[Bosch_Guido]

Nee je hebt gelijk, bij deze macro gebruik ik x niet. Die regels kan ik dan weghalen..
Op true zetten kan wel...
Blijft het zo dat de waarden niet verwijderd worden.. hier de complete code:

Sub Selecteer_alle_bassins()

Application.ScreenUpdating = False

Dim c As Variant

If Range("H11") = True Then
Rows("14:65").EntireRow.Hidden = False
Range("H4:H11") = True
Range("A4:A10").Copy Destination:=Sheets("Cursusaanbod").Range("H4")
Range("B11").Select

Else:

Rows("14:65").EntireRow.Hidden = True
Range("H4:H11") = False

With Sheets("Cursusaanbod")
For Each c In Range("H1:H100")
If c.Value = Range("A4").Value Or c.Value = Range("A5").Value Or c.Value = Range("A6").Value Or c.Value = Range("A7").Value Or c.Value = Range("A8").Value Or c.Value = Range("A9").Value Or c.Value = Range("A10").Value Then
c.Delete Shift:=xlUp
End If
Next c
End With

Range("B11").Select

End If

Application.ScreenUpdating = True
End Sub

Wie snapt het wel?

 

[franç]

Ik heb je code niet getest, maar dit valt me op:
Dim c as variant moet zijn:
Dim c as object

Verder, die vergelijkingen: If c.value = enz., dat is niet fout maar daar kun je toch beter een do until of iets dergelijks van maken?

 

[Bosch_Guido]

Graag! Alleen hoe?

 

[franç]

Ik maakte een vergissing:
waar bij jou staat: dim c as variant moet niet zijn dim c as object maar dim c as range
Dan do - until-opdracht (kijk in helpfile, wordt daar goed uitgelegd), bv. zo
a = 4
Do Until a = 11
If c.Value = Range("A" & a).Value Then
'hier wat er moet gebeuren als voorwaarde waar is
End If
a = a + 1
Loop

Ik heb geen tijd om je macro uitvoerig te gaan bewerken en testen, daarom nog slechts deze opmerkingen:
het gebruik van range(....) = true en range(....) = false vind ik merkwaardig. Voor excel is een bewering/opdracht altijd waar of onwaar, dus het opnemen van zulke opdrachten lijkt mij discutabel.
let bij bv. for x = .... next x op de waarde van x als je rijen verwijdert.

 

[Bosch_Guido]

Oké ik heb het nu als volgt opgelost. Zonder lussen en alles, maar met een aantal aparte macro's om de snelheid te bevorderen. Met dank aan enkele forummers

Sub Selectievakje1_BijKlikken()
'25/50 meter bad (cel A4 en in H4 staat WAAR/ONWAAR)

Selecteer_bassin "A4", Range("H4"), "14:22"
End Sub

Sub Selecteer_bassin(badcel As String, aanuit As Boolean, Optional rijen As String)
Application.ScreenUpdating = False

Dim c As Variant
Dim x As Long

'Kijk waar de eerste gevulde cel in kolom H van sheet "Cursusaanbod" van onder af staat
With Sheets("Cursusaanbod")
x = .Cells(Rows.Count, "H").End(xlUp).Row
End With

'Range A kopieren als H waar is en rijen laten zien indien nodig

With ActiveSheet
If aanuit Then
For Each c In Sheets("Cursusaanbod").Range("H4:H100")
If c = Range(badcel) Then
c.Delete Shift:=xlUp
End If
Next c
Range(badcel).Copy Destination:=Sheets("Cursusaanbod").Range("H" & x).Offset(1, 0)
If rijen <> "" Then Rows(rijen).EntireRow.Hidden = False
Range(badcel).Offset(0, 1).Select
Else
For Each c In Sheets("Cursusaanbod").Range("H4:H100")
If c = Range(badcel).Value Then
c.Delete Shift:=xlUp
End If
Next c
If rijen <> "" Then Rows(rijen).EntireRow.Hidden = True
Range(badcel).Offset(0, 1).Select
End If
End With

Application.ScreenUpdating = True
End Sub

Als hier nog op of aanmerking over zijn dan hoor ik ze graag!