Opgelost VBA oplossing gevraagd

[Re19]

Ik heb een probleem en kom er niet meer uit, ik heb een grote database waaruit ik het volgende filter met VBA

nu wil ik de dubbele gegevens verwijderd hebben, maar kom er niet uit.
voorbeeld: de woensdag (licht gekleurd) moet erin blijven als het kenmerk een R bezit de dubbele woensdag (geel gekleurd) deze hele regel kan dus verwijderd worden.
de Donderdag (licht groen) moet erin blijven omdat het kenmerk een R bezit de dubbele donderdag (donker groen) deze gehele regel kan dus verwijderd worden.

ik hoop dat iemand mij kan helpen met een VBA code of in ieder geval een begin kan geven.
Alvast bedankt.

 

[sylvester-ponte]

je bent iets vergeten

 

[Re19]

Ja een goede opmerking Sylvester.

ik gebruik excel 365

 

[Haije]

Er mist een voorbeeld Excel

Kijk eens of je hier verder mee komt. Kijk onder het filter

 

[Re19]

Hoi Haije
ik heb er een voorbeeld bestand bijgedaan. (jou bestand aangevuld met een deel van de database)
omdat bijv de woensdag er dubbel instaat wil ik regel 6 verwijderd hebben omdat in het kenmerk van regel 4 een R vermeld staat.

ik hoop dat je er iets mee kan ?

 

[Haije]

In je macro geef je zelf op in één van de filters dat r2 meegenomen moet worden.
En nu moet die weer verwijderd worden?
Waarom dan opnemen in het filter?

 

[emields]

en wat met dubbel waar er geen R te bespeuren is?

 

[Re19]

nee de R2 moet behouden blijven die woensdag (met 42Z1-52) moet verdwijnen en hij moet verdwijnen omdat er al een woensdag bestaat die met de "R"

 

[Re19]

in kolom I staan voor de rest geen dubbele dagen dan woensdag en donderdag in deze week, in een andere week kunnen het andere dagen zijn.

 

[emields]

alle gele zijn dubbele

 

[Re19]

Ik snap niet hoe je kolom I geel krijgt ?
het gaat erom dat hij kijkt naar het week nr. bijv:4 daar filtert hij op dagen in kolom H en in kolom H zie je dan dubbele dagen Woensdag 24-1 en daarvan moet hij diegene behouden waarvan het kenmerk een R bevat (bij kenmerk: 42R2-19) de andere met kenmerk (42Z1-52) die gehele regel mag verwijderd worden.

Dim x1, kolom1, rij1

kolom1 = 10
rij1 = 13
Sheets("blad2").Select
Rows("1:1").Select
Selection.AutoFilter
For x1 = 1 To 4
Sheets("blad2").Select
ActiveSheet.Range("$A$1:$U$852").AutoFilter Field:=4, Criteria1:=x1
ActiveSheet.Range("$A$1:$U$852").AutoFilter Field:=2, Criteria1:= _
"**z***", Operator:=xlOr, Criteria2:="**r2**"
Selection.SpecialCells(xlCellTypeVisible).Select
Range("$A$2:$U$852").Select
Selection.Copy
Sheets("blad3").Select

Range("B3").Select
ActiveSheet.Paste

' hier tussen moet een code om te kijken of er dubbele io's in zitten

Range("B3:L9").Select
ActiveWorkbook.Worksheets("blad3").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("blad3").Sort.SortFields.Add2 Key:=Range( _
"J3:J9"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"Maandag,Dinsdag,Woensdag,Donderdag,Vrijdag,Zaterdag,Zondag", DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("blad3").Sort
.SetRange Range("B3:L9")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


Next x1

 

[Re19]

misschien heeft een ander er ook wat aan maar ik ben eruit.
met de volgende code werkt het perfect.
Sub test2()
Dim a, a1, a2
For a = 3 To 11
a1 = Range("i" & a).Value
a2 = Range("i" & a + 1).Value
a3 = Range("c" & a).Value
If a1 = a2 Then
If Range("c" & a) Like "*R2*" Then Cells(a + 1, "a").EntireRow.Delete

End If
Next a

End Sub

 

[emields]

code kan niet perfect werken, je maakt ons en jezelf wat wijs.