VBA Excel AutoFilter incorrect 1e resultaat

Pagina: 1
Acties:

Vraag


Acties:
  • 0 Henk 'm!

  • Crahsystor
  • Registratie: Februari 2009
  • Laatst online: 16:07
Ik probeer een mix van wedstrijdprogramma en uitslagen te splitsen met VBA in Excel (O365). Op zich lukt dit goed, ook al heb ik geen ervaring met VBA. Ik heb een Module gevonden die met behulp van AutoFilter netjes onderscheid kan maken tussen de twee verschillende Rows. Deze macro splitst de input (samengesteld schema en uitslagen) in programma en uitslagen. Maar er gaat altijd 1, niet meer of minder, Row verkeerd. Afhankelijk van of de eerste Row een uitslag is of programma, komt een uitslag in programma of een programma in uitslag terecht.
Het speelt zich allemaal af in 1 workbook en verdeeld over 3 sheets. (Input, Programma, Uitslagen)
Data komt in Programma en Uitslagen niet binnen op A1, maar ergens anders en dat werkt prima. Input zal steeds een volledig nieuwe Paste zijn. Programma en Uitslagen heeft al Headers, dus die neem ik niet mee in de AutoFilter range. Ik filter op kolom K, Thuis.

Een voorbeeld van de vulling van Input:
Voorbeeld Input

En voorbeeld hoe dat gesplitst er uit zou moeten komen:
Voorbeeld gewenste uitslagen
&
Voorbeeld gewenst programma

Wat er bijvoorbeeld fout uit komt op programma:
Voorbeeld fout programma

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub SplitsProgrammaUitslagen()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim rng As Range, rngToCopy As Range
    Dim lastrow As Long
    Set ws1 = ThisWorkbook.Worksheets("Input")
    Set ws2 = ThisWorkbook.Worksheets("Programma")
    Set ws3 = ThisWorkbook.Worksheets("Uitslagen")

' Programma
    With ws1
        'assumung data stored in column A:M, Input
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rng = .Range("A2:M" & lastrow)
        'clear all filters
        .AutoFilterMode = False
        With rng
            'apply filter (K is column 11) FIND BLANK for Programma
            .AutoFilter Field:=11, Criteria1:="="
            On Error Resume Next
            'get only visible rows
            Set rngToCopy = .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
        End With
        'copy range for Programma
        If Not rngToCopy Is Nothing Then rngToCopy.Copy Destination:=ws2.Range("G4")
        'clear all filters
        .AutoFilterMode = False
    End With
    Application.CutCopyMode = False
       
' Uitslagen
    With ws1
        'assumung data stored in column A:M, Input
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rng = .Range("A2:M" & lastrow)
        'clear all filters
        .AutoFilterMode = False
      With rng
            'apply filter (K is column 11) FIND NOT BLANK for Uitslagen
            .AutoFilter Field:=11, Criteria1:="<>"
            On Error Resume Next
            'get only visible rows
            Set rngToCopy = .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
        End With
        'copy range for Uitslagen
        If Not rngToCopy Is Nothing Then rngToCopy.Copy Destination:=ws3.Range("E4")
        'clear all filters
        .AutoFilterMode = False
    End With
    Application.CutCopyMode = False
End Sub


Het lijkt er dus op dat het AutoFilter Criteria op het eerste resultaat verkeerd mag zijn en deze toch mee mag naar de Copy. Ik verdenk de error handling van 'On Error Resume Next' (regel 19&41) maar heb nog niks concreets kunnen vinden hoe dat precies te testen of correct af te vangen.
Gezien de consistentie van de 'foute' resultaten zal dit wel een inkoppertje zijn voor wie vaker met dit bijltje gehakt heeft. Ik heb zelf nog niet kunnen vinden wat het precies is na een paar uur zoeken. Vandaar dit topic met de vraag of iemand me in de juiste richting kan sturen.

Addicted to silent computing

Alle reacties


Acties:
  • +1 Henk 'm!

  • Crahsystor
  • Registratie: Februari 2009
  • Laatst online: 16:07
Om mezelf maar te beantwoorden: Autofilter neemt aan dat de eerste Row een Heading is. Ongeacht wat je Range is blijkbaar. Ik heb de code aangepast zodat de Heading altijd meegenomen word en later uit de resultaten verwijderd.
Niet elegant, maar simpel. Regel 11-12, 22-23, 32-33
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub SplitsProgrammaUitslagen()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim rng As Range, rngToCopy As Range
    Dim lastrow As Long
    Set ws1 = ThisWorkbook.Worksheets("Input")
    Set ws2 = ThisWorkbook.Worksheets("Programma")
    Set ws3 = ThisWorkbook.Worksheets("Uitslagen")

' Programma
    With ws1
        'Unhide all Rows
        Rows.EntireRow.Hidden = False
        'assumung data stored in column A:M, Input
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rng = .Range("A1:M" & lastrow)
        'clear all filters
        .AutoFilterMode = False
        With rng
            'apply filter (K is column 11) FIND BLANK for Programma
            .AutoFilter Field:=11, Criteria1:="="
            On Error Resume Next
            'Hide Header
            Rows(1).EntireRow.Hidden = True
            'get only visible rows
            Set rngToCopy = .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
        End With
        'copy range for Programma
        If Not rngToCopy Is Nothing Then rngToCopy.Copy Destination:=ws2.Range("G4")
        'clear all filters
        .AutoFilterMode = False
        'Unhide all Rows
        Rows.EntireRow.Hidden = False
    End With
    Application.CutCopyMode = False
       
' Uitslagen
    With ws1
        'Unhide all Rows
        Rows.EntireRow.Hidden = False
        'assumung data stored in column A:M, Input
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rng = .Range("A1:M" & lastrow)
        'clear all filters
        .AutoFilterMode = False
      With rng
            'apply filter (K is column 11) FIND NOT BLANK for Uitslagen
            .AutoFilter Field:=11, Criteria1:="<>"
            On Error Resume Next
            'Hide Header
            Rows(1).EntireRow.Hidden = True
            'get only visible rows
            Set rngToCopy = .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
        End With
        'copy range for Uitslagen
        If Not rngToCopy Is Nothing Then rngToCopy.Copy Destination:=ws3.Range("E4")
        'clear all filters
        .AutoFilterMode = False
        'Unhide all Rows
        Rows.EntireRow.Hidden = False
    End With
    Application.CutCopyMode = False
End Sub
Het werkt nu.
Typish iets wat wel bij de Definition van AutoFilter had mogen staan in de IDE imho, dat de eerste Row tot Heading gebombardeerd word. Maargoed, misshien heeft iemand er nog wat aan in de toekomst.
Ik had nog een elegantere oplossing geprobeerd voor het geheel, maar blijkbaar werken objecten in VBA iets anders dan ik gewend ben. Dus veel redundantie waarschijnlijk.

Addicted to silent computing