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

Foutenafhandeling autofilter

Status
Niet open voor verdere reacties.
S

Symphysodon

Gebruiker
Lid geworden
14 dec 2012
Berichten
468
Bete forummers,

Ik dacht een eenvoudig autofilter te maken maar stuit meteen op een probleem wanneer het filter niks vindt.
Code: 
    For Each std In Array("45", "46", "47", "48", "51", "6", "7", "8")
        Debug.Print std
        Rng2.AutoFilter 9, Criteria1:=std
        With .AutoFilter.Range
            On Error Resume Next
            Set Rng = .Offset(1, 11).Resize(.Rows.Count - 1, 12).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not Rng Is Nothing Then
                pR = Sheets("Data").Cells(Rows.Count, i).End(xlUp).Row + 1
                Rng.Copy
                Sheets("Data").Cells(pR, i).PasteSpecial xlValue
            End If
        End With
        i = i + t
    Next

Mocht het nodig zijn dan maak ik nog een voorbeeldbestand.

Mvg
Marco
 
Het zit denk ik in het meefilteren van de koprij (2.1). Als ik
Code: 
            Set Rng = .Offset(1, 11).Resize(.Rows.Count - 1, 12)
aanpas in
Code: 
            Set Rng = .Offset(, 11).Resize(.Rows.Count - 1, 12)
, blijven de velden die leeg moeten blijven leeg alleen wordt er nu bij elke te kopieren bereik een lege koprij mee geplakt.
 
Bij deze de code en het voorbeeld.
Code: 
Sub vul1()
Dim Rng As Range
Dim std As Variant
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With
t = 12 'aantal elementen
With ActiveWorkbook.Sheets("Exported Analyses")
    Set Rng2 = .[a1].CurrentRegion.Offset(1).Resize(.[a1].CurrentRegion.Rows.Count - 1, .[a1].CurrentRegion.Columns.Count)
    i = 2
    For Each std In Array("A", "B")
        Rng2.AutoFilter 9, Criteria1:=std
        With .AutoFilter.Range
            On Error Resume Next
            Set Rng = .Offset(, 11).Resize(.Rows.Count, 12)
            On Error GoTo 0
            If Not Rng Is Nothing Then
                pR = Sheets("Data").Cells(Rows.Count, i).End(xlUp).Row + 1
                Rng.Copy
                Sheets("Data").Cells(pR, i).PasteSpecial xlValue
            End If
        End With
        i = i + t
    Next
    .AutoFilterMode = False
    .Rows(1).EntireRow.Delete
End With
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With
End Sub

In het voorbeeld is er geen std B maar er wordt vervolgens wel wat gekopieerd en geplakt
 

Bijlagen

  • Autofilter.xlsm
    20,6 KB · Weergaven: 21
Code: 
Sub VenA()
  ar = Array("A", "B")
  With Sheets("Exported Analyses").Cells(1).CurrentRegion
    For j = 0 To UBound(ar)
      .AutoFilter 9, ar(j)
      .Offset(1, 11).Resize(, 12).Copy Sheets("Data").Cells(Rows.Count, j * 12 + 2).End(xlUp).Offset(1)
    Next j
    .AutoFilter
  End With
End Sub
 
Code: 
Sub M_snb()
  With Sheets("Exported Analyses").Cells(1).CurrentRegion.columns(9)
     .AutoFilter 1, Array("A", "B"),7
     .Offset(1, 2).Resize(, 12).Copy Sheets("Data").Cells(Rows.Count, 2).End(xlUp).Offset(1)
     .AutoFilter
  End With
End Sub
 
De code van VenA werkt, bij snb zal wel een typefout zitten maar de code filtert niet of niet goed.

Maar wat nou als ik in de datasheet in kolom a de datum wil hebben van het exportbestand. Ik kan eerst sorteren op datum (kolom 4, 5 en 6) maar dan..
Ik heb het voorbeeld wat uitgebreider gemaakt.
Code: 
datum = DateSerial(Sheets("Exported Analyses").Cells(sR, 6), Sheets("Exported Analyses").Cells(sR, 5), Sheets("Exported Analyses").Cells(sR, 4))

Code: 
Sub vul1()
Dim std As Variant
  Application.ScreenUpdating = False
  std = Array("A", "B", "C", "D", "E", "F")
  With Sheets("Exported Analyses").Cells(1).CurrentRegion
    For j = 0 To UBound(std)
      .AutoFilter 9, std(j)
      .Offset(1, 11).Resize(, 12).Copy
      Sheets("Data").Cells(Rows.Count, j * 12 + 2).End(xlUp).Offset(1).PasteSpecial xlValues
    Next j
    .AutoFilter
  End With
    Application.ScreenUpdating = True
End Sub
 

Bijlagen

  • Autofilter.xlsm
    21,6 KB · Weergaven: 21
Waarom wil je deze nogal onhandige opzet als resultaat. Ik zou de hele handel transformeren naar een logische tabel en van daaruit verder werken.
 
Als dat zou kunnen graag. Maar het exportbestand is het exportbestand en daar kan niks aan gewijzigd worden en in de data sheet staan de standaarden in een logische alfabetische volgorde met per standaard 12 elementen. De volgende stap is dat per element (lees kolom) een grafiek gemaakt wordt als functie van de tijd. Maar eerst moet dit goed. Het gaat me wel lukken, alleen wat jij in een minuut uit je mouw schud daar doe ik minstens 4 uur over en niet doen is in dit geval geen optie. Soms gaat het wat sneller :)
 
Een ruwe opzet zou toch zo kunnen zijn:
1. Sorteren op jr, mnd, dg, hr
2. filteren op jr, mnd, dg
3. Van resultaat 2 datum en data kopieren/plakken naar data sheet
4. Terug naar 2
 
De sorteer code zou dan zo kunnen:
Code: 
Sub Sorteer_exp()
'sorteren exportbestand
         
Application.ScreenUpdating = False
With Sheets("Exported Analyses")
    Kolomstart = 12
    r = 1
    
    .Cells(3, 1).EntireRow.Insert
    Set Rng2 = .[a3].CurrentRegion
    .Sort.SortFields.Clear
    r = 3
    Set e = .Range(.Cells(r, 9), .Cells(r, 9).End(xlDown))
    Set Y = .Range(.Cells(r, 6), .Cells(r, 6).End(xlDown))
    Set M = .Range(.Cells(r, 5), .Cells(r, 5).End(xlDown))
    Set d = .Range(.Cells(r, 4), .Cells(r, 4).End(xlDown))
    With .Sort
        .SortFields.Add Key:=Y
        .SortFields.Add Key:=M
        .SortFields.Add Key:=d
        .SortFields.Add Key:=e
        .SetRange Rng2
        .Header = xlNo
        .Apply
    End With
    .Cells(2, 1).EntireRow.Delete
End With
Application.ScreenUpdating = True
End Sub
 
Het is misschien handiger om eerst een datum te genereren in kolom A
Code: 
Sub Sorteer_exp()
'sorteren exportbestand
         
Application.ScreenUpdating = False
With Sheets("Exported Analyses")
    k = 1
    For i = 2 To .Cells(Rows.Count, k).End(xlUp).Row
        .Cells(i, k) = DateSerial(.Cells(i, 6), .Cells(i, 5), .Cells(i, 4))
    Next
    .Cells(2, 1).EntireRow.Insert
    Set Rng2 = .[a3].CurrentRegion
    .Sort.SortFields.Clear
    r = 3
    Set e = .Range(.Cells(r, 1), .Cells(r, 1).End(xlDown))
    With .Sort
        .SortFields.Add Key:=e
        .SetRange Rng2
        .Header = xlNo
        .Apply
    End With
    .Cells(2, 1).EntireRow.Delete
End With
Application.ScreenUpdating = True
End Sub
 
De code van #8 werkt perfekt in het door jou geplaatste bestand..
Jouw commentaar is niet-informatief.
 
Toppunt van luiheid om de code niet te analyseren en niet zelf even 1 getal te wijzigen:
Blijkbaar heb je ook niets gedaan met de link die ik eerder plaatste.

Code: 
Sub M_snb()
  With Sheets("Exported Analyses").Cells(1).CurrentRegion.columns(9)
     .AutoFilter 1, Array("A", "B"),7
     .Offset(1, 3).Resize(, 12).Copy Sheets("Data").Cells(Rows.Count, 2).End(xlUp).Offset(1)
     .AutoFilter
  End With
End Sub
 
Je wilt helpen, maar eigenlijk ook weer niet. Gek is dat toch.

Het werkt in het voorbeeld maar misschien was de vraagstelling niet helemaal duidelijk. Alle items van de array moeten verwerkt worden. In het voorbeeld was wel data van A maar geen data van B, tja en dan werkt jou code wel. Maar zodra er ook data van B in zit dan wordt alles onder elkaar geplakt.

En voor de goede orde, ik heb jou link wel degelijk bekeken, daar is mijn eerste post deels op gebaseerd. Maar ook die code werkt alleen alles alle items van de array aanwezig zijn, zodra er een item niet is gaat het mis en daar zegt jou link niks over.
 
Maar het exportbestand is het exportbestand en daar kan niks aan gewijzigd worden
Klik om te vergroten...
Tuurlijk wel. Het gepruts van mensen met, hoe zal ik voorzichtig zeggen, iets minder kennis van Excel kost meer tijd/geld dan even de export aan te laten passen.
alleen wat jij in een minuut uit je mouw schud daar doe ik minstens 4 uur
Klik om te vergroten...
Ik schut nooit wat uit mijn mouw. Op dit forum bestudeer ik veel reacties om ervan te leren.
Op mijn werk geef ik aan dat ik 4 uur per week bezig ben om een niet zo'n beste export om te zetten naar iets leesbaars. En dan gaat er iemand een kosten/risico-analyse maken. Binnen de kortste keren krijg ik het aangeleverd zoals ik het wil.:d

In de bijlage het e.e.a opgelost met powerquery.
 

Bijlagen

  • Autofilter (1).xlsm
    42,5 KB · Weergaven: 79
Hoi VenA,
Het exportbestand is helaas niet aan te passen zodat je per aanduiding een set met elementen krijgt. Je kan hooguit de inhoud en de volgorde van de eerste paar kolommen aanpassen, maar je zal altijd een inzetlijst hebben met bijhorende meetresultaten. Het is ook geen Excel waar het exportbestand uit wordt gegenereerd.

Het antwoord is wel precies zoals ik het bedoel, ik begrijp alleen nog niet hoe ik dit met een 'druk op de knop' voor elkaar kan krijgen. Bedankt in ieder geval, ik ga ermee aan de slag.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan