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

Een filter laten beperken tot de hoogste 60 getallen.

Status
Niet open voor verdere reacties.
D

Depant

Verenigingslid
Lid geworden
5 aug 2015
Berichten
238
Hallo allemaal,

Onderstaand filter in een macro selecteerd een aantal getallen en zet die weg op een bepaalde positie. Dat stukje werkt uitstekend. Nu is mijn vraag of het ook zo te maken is dat als het meer dan 60 nummers zijn, alleen de hoogste 60 nummers worden weggekopieerd.
Ik hoop dat jullie mij kunnen helpen.

Graag voeg ik een bestandje toe. ( en ga nu thuis de tot nu toe gegeven oplossingen proberen)
Ik heb een hoop weggehaald om het bestand niet te groot te maken.


Bij voorbaat hartelijk dank voor jullie hulp.
Met deze selectie krijg ik alles


Code: 
Sub Selecteren()
' Selecteren Macro

    Sheets("Verz").Select
    Range("C15:C300").Select
    Selection.ClearContents
    
With Sheets("alles")
 .Cells(1).CurrentRegion.AutoFilter 1, Filter(Application.Transpose([if(stam!O1:O31="","~",stam!O1:O31)]), "~", False), 7
 .Cells(1).CurrentRegion.AutoFilter 5, Filter(Application.Transpose([if(stam!n1:n10="","~",stam!n1:n10)]), "~", False), 7
 .AutoFilter.Range.Offset(1).Columns(2).Copy Sheets("verz").Range("c15")
    Sheets("alles").Select
    ActiveSheet.ShowAllData
    Selection.AutoFilter
    Sheets("Verz").Select
    
        With ActiveWorkbook.Worksheets("Verz").Sort
        .SetRange Range("C15:C300")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End With
End Sub



60 stuks van bovenstaande selectie, maar ik wil dan graag de hoogste nummers.
Zover is mijn poging......:(:(:(


Code: 
Sub laatste60()
'

Sheets("Verz").Range("C15:C3000").ClearContents

    With Sheets("alles")
      .Cells(1).CurrentRegion.AutoFilter 1, Filter(Application.Transpose([if(stam!O1:O31="","~",stam!O1:O31)]), "~", False), 7
      .Cells(1).CurrentRegion.AutoFilter 5, Filter(Application.Transpose([if(stam!n1:n10="","~",stam!n1:n10)]), "~", False), 7
      .AutoFilter.Range.Offset(1).Columns(2).Copy Sheets("verz").Range("C15")
      End With

    With Sheets("Verz").Range("C15").CurrentRegion
      .Sort .Range("C15"), 1, , , , , , xlYes
      .Offset(61).Clear
      
    End With
End Sub





Bekijk bijlage nir1 16.07LV.xlsm
 

Bijlagen

  • hm.xlsm
    268,2 KB · Weergaven: 27
Laatst bewerkt:
Bij gebrek aan een voorbeeld bestandje zou je ze na rij 60 ook kunnen verwijderen
Code: 
Sheets("Verz").Range("C15").CurrentRegion.Offset(61).Clear
 
Volgens mij kan je filter ook nog aangepast worden in deze code maar dan heb ik een voorbeeld bestandje nodig.​
Code: 
Sub Selecteren()  Sheets("Verz").Range("C15:C300").ClearContents

    With Sheets("alles")
      .Cells(1).CurrentRegion.AutoFilter 1, Filter(Application.Transpose([if(stam!O1:O31="","~",stam!O1:O31)]), "~", False), 7
      .Cells(1).CurrentRegion.AutoFilter 5, Filter(Application.Transpose([if(stam!n1:n10="","~",stam!n1:n10)]), "~", False), 7
      .AutoFilter.Range.Offset(1).Columns(2).Copy Sheets("verz").Range("C15")
      .AutoFilter
    End With

    With Sheets("Verz").Range("C15").CurrentRegion
      .Sort .Range("C15"), 1, , , , , , xlYes
      .Offset(61).Clear
    End With

End Sub
 
Hallo allemaal,

Bedankt voor jullie reacties. Ik heb het voorbeeldbestand inmiddels geplaatst, maar het lijkt er op dat de van de reeks getallen de eerste 60 worden behouden en de rest wordt verwijderd. Terwijl het andersom de bedoeling is. Van de nummers die gegenereerd moeten de hoogste 60 worden gekopieerd en de rest moet worden verwijderd. Ik hoop dat dit ook mogelijk is.:(

Groeten Henk Harbers
 
verander de 1 in een 2
Code: 
    With Sheets("Verz").Range("C15").CurrentRegion
      .Sort .Range("C15"), [COLOR="#FF0000"]2[/COLOR], , , , , , xlYes
      .Offset(61).Clear
    End With
 
Laatst bewerkt:
Hallo allemaal,

Heb zelf nog wat lopen tobben maar kan de winst niet binnenhalen.
Ik heb de sorteersleutel nog niet goed. Wil iemand mij het laatste zetje geven.
Heb een ander bestand toegevoegd. 16.07
:thumb:
 
Laatst bewerkt:
Als je een bestand kunt toevoegen kun je voor de leesbaarheid van je bericht ook code tags toevoegen.
 
code tags

Geachte allemaal,

Graag wil ik aangeven dat ik niet verder kom dan de informatie die jullie mij de afgelopen jaren gegeven hebben.
Natuurlijk zou ik graag de code tags willen toevoegen. Maar ik heb te weinig kennis om dit te doen.:(:(:(
Is dit in Jip en Janneke taal uit te leggen??

Met de vriendelijke groeten Henk
 
Open je eerste post en selecteer je code.
Vervolgens klik je op de #.
Moet lukken.

Groeten
 
Dan heb je de link in #4 over het hoofd gezien ?
 
Annie MG. Wie is er níet groot mee geworden? :)
Jip-en-janneketaal is een samengesteld woord. Je schrijft het met streepjes en zónder hoofdletters.
Maar dat terzijde.
 
Hallo allemaal.

Het probleem is niet opgelost, maar ik kan tenminste de vraag wat beter stellen
Dit in het kader. "Beter langazaam vooruitkomen dan eeuwig stilstaan"
Ik hoop dat jullie me verder kunnen helpen.
Het bestand nir 1 16.07 geeft mijn probleem weer.

Hartelijk dank alvast:thumb:


En oeps nu het is aangepast snap ik wat jullie bedoelen.:shocked:

Selecteren werkt wel.

Code: 
Sub Selecteren()
' Selecteren Macro

    Sheets("Verz").Select
    Range("C15:C1000").Select
    Selection.ClearContents
    
With Sheets("alles")
 .Cells(1).CurrentRegion.AutoFilter 1, Filter(Application.Transpose([if(stam!O1:O31="","~",stam!O1:O31)]), "~", False), 7
 .Cells(1).CurrentRegion.AutoFilter 5, Filter(Application.Transpose([if(stam!n1:n10="","~",stam!n1:n10)]), "~", False), 7
 .AutoFilter.Range.Offset(1).Columns(2).Copy Sheets("verz").Range("c15")
    Sheets("alles").Select
    ActiveSheet.ShowAllData
    Selection.AutoFilter
    Sheets("Verz").Select
    
        With ActiveWorkbook.Worksheets("Verz").Sort
        .SetRange Range("C15:C1000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End With
End Sub



Werkt niet om de hoogste laatste 60 te selecteren.

Code: 
Sub laatste60()
'

Sheets("Verz").Range("C15:C1000").ClearContents

    With Sheets("alles")
      .Cells(1).CurrentRegion.AutoFilter 1, Filter(Application.Transpose([if(stam!O1:O31="","~",stam!O1:O31)]), "~", False), 7
      .Cells(1).CurrentRegion.AutoFilter 5, Filter(Application.Transpose([if(stam!n1:n10="","~",stam!n1:n10)]), "~", False), 7
      .AutoFilter.Range.Offset(1).Columns(2).Copy Sheets("verz").Range("C15")
      End With

    With Sheets("Verz").Range("C15").CurrentRegion
      .Sort .Range("C15"), 1, , , , , , xlYes
      .Offset(61).Clear
      
    End With
End Sub
 
Laatst bewerkt:
Zo misschien
 

Bijlagen

  • nir1 16.07LV (1).xlsm
    127,9 KB · Weergaven: 42
Hartelijk dank!!!

Hallo allemaal.

Ik ben er reuze blij mee:thumb::thumb::thumb:

Bedankt voor de hulp!!
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan