Met een druk op de knop gefilterde gegevens exporteren naar ander werkblad

Status
Niet open voor verdere reacties.
P

Piebepost

Gebruiker
Lid geworden
10 mrt 2010
Berichten
19
Beste Helpmij'ers,

Ik ben nu een tijdje bezig met een uitgebreide excelapplicatie die voorcalculaties met nacalculaties vergelijkt. Daar ik een leek ben op dit gebied heeft het voor mij nog heel wat voeten in de aarde maar ik maak gestaag vorderingen :)

In de bijlage heb ik een (versimpelde) voorbeeldapplicatie gezet.
In het tabblad Data staan de brongegevens. In de laatste kolommen staan de afwijkingen van de nacalculaties ten opzichte van de voorcalculaties.
Nu wil ik in het tabblad Afwijkingen graag een overzicht hebben van alle rijen uit Data waarbij grotere afwijkingen tussen de nacalculaties ten opzichte van de voorcalculaties hebben plaats gevonden als aangegeven bovenin het werkblad . Dit houdt dus in dat wanneer ik in cel E2 aangeef afwijkingen vanaf 10% te willen zien ik alle records wil met afwijkingen van <-10% en >10% (met unieke records op basis van productnummer). Dit wil ik graag doen met een knop, die ik al heb geplaatst bovenin de applicatie.

Ik heb vanalles opgezocht en uitgeprobeert maar daar zal ik jullie maar niet mee opzadelen. Als ik hier zo door het forum blader zie ik dat jullie veel beter kunnen proberen dan ik...

Wie kan mij helpen?

Mvg,
Jelle

Bekijk bijlage VOCANACA applicatie voorbeeld Helpmij.nl.xlsx

N.B. Overigens vind ik dit wel een goede gelegenheid om Helpmij te complimenteren. Wat een fantastische site. Als je een probleem hebt heb je dat vaak na een halfuurtje opgelost door door Helpmij te bladeren. Als blijk van waardering heb ik zopas een bedrag naar de vereniging overgemaakt. Super!

Aanpassing: uitleg voorbeeld.
Wampier gaf aan dat het voorbeeld misschien wat onduidelijk is, daarom nog even een extra uitleg:
Het gaat om de verhouding van de nacalculaties ten opzichte van de voorcalculaties. In het tabblad "Data" staan de voor- en nacalculaties van de man- en machineuren van meerdere projecten. In de kolomnamen staan de afkortingen "VOCA" en "NACA", die staan voor VOorCAlculatie en NACAlculatie. De kolommen "afwijkingen" geven de verschillen aan in percentages tussen nacalculaties en voorcalculaties. Dezen staan in de kolommen "I" en "J".
En deze percentages in "I" en "J" gaat het mij om. Dezen moeten groter zijn dan óf kleiner zijn dan het negatief van de criteria die ik opgeef in "Afwijkingenblad".
Als ze dat zijn dan wil ik de betreffende records zien in "afwijkingenblad" onder de criteria.

De tabbladen "Achtergrond" en "Draaitabel" hebben hiervoor geen waarde.
 
Laatst bewerkt:
mogelijk zijn mensen verward door het voorbeeld ;)

als ik kijk naar je afwijkingenblad dan missen daar een aantal entries.

Wat je wil (denk ik): loop door de sheet data heen. indien [data]I<y> meer afwijkt dan [afwijkingenblad]E2 en [d...]J<y> meer afwijkt dan [a...]E3 moet de lijn gecopieerd worden op het afwijkingenblad?

op zich is dat prima te doen met VBA. Je kunt natuurlijk ook 2 custom filters loslaten op data en deze doorlopen.

Indien het zeer veel data betreft is het makkelijkste: maak een extra kolom op het "Data"-sheet met een IF statement die aangeeft of het een afwijkende waarde betreft en laat hier een eenvoudig filter op los. zelfde resultaat, maar veel sneller en behoeft weinig programmeerwerk. Indien je een probleem met standaard middelen op kan lossen heeft dat wat mij betreft altijd de voorkeur.

kolom K in d "DATA" sheet:
Code: 
=IF((ABS(I2)>Afwijkingenblad!$E$2)+(ABS(Data!J2)>Afwijkingenblad!$E$3);1;0)
 
Laatst bewerkt:
wampier zei:
mogelijk zijn mensen verward door het voorbeeld ;)

als ik kijk naar je afwijkingenblad dan missen daar een aantal entries.

Wat je wil (denk ik): loop door de sheet data heen. indien [data]I<y> meer afwijkt dan [afwijkingenblad]E2 en [d...]J<y> meer afwijkt dan [a...]E3 moet de lijn gecopieerd worden op het afwijkingenblad?

op zich is dat prima te doen met VBA. Je kunt natuurlijk ook 2 custom filters loslaten op data en deze doorlopen.

Indien het zeer veel data betreft is het makkelijkste: maak een extra kolom op het "Data"-sheet met een IF statement die aangeeft of het een afwijkende waarde betreft en laat hier een eenvoudig filter op los. zelfde resultaat, maar veel sneller en behoeft weinig programmeerwerk. Indien je een probleem met standaard middelen op kan lossen heeft dat wat mij betreft altijd de voorkeur.

kolom K in d "DATA" sheet:
Code: 
=IF((ABS(I2)>Afwijkingenblad!$E$2)+(ABS(Data!J2)>Afwijkingenblad!$E$3);1;0)
Klik om te vergroten...

Bedankt voor je reactie!

Dat is inderdaad precies wat ik wil.
Over deze oplossing heb ik ook wel nagedacht maar heb ik afgeschoten om twee redenen:
1. Overzicht: Hier staan maar een stuk of 20 records. In de echte applicatie staan duizenden.
2. Omdat de applicatie door het hele bedrijf gebruikt zal worden is het zaak dat de applicatie uiterst gebruiksvriendelijk is.

De code die ik tot nu toe heb:

Code: 
Sub filter()

    'Algemene variabelen
    Dim alleGegevensGehad As Boolean
    Dim alleUitvoerGehad As Boolean
    Dim sorteerOpUniekeProductnr As Boolean
    Dim toegestaneAfwijkingMan As Double
    Dim toegestaneAfwijkingMach As Double
    Dim toegestaneAfwijkingManNegatief As Double
    Dim toegestaneAfwijkingMachNegatief As Double
    
    'Algemene variabelen instellen
    alleGegevensGehad = False
    alleUitvoerGehad = False
    sorteerOpUniekeProductnr = True

    'Variabelen met betrekking tot werkblad data
    Dim werkbladnaamDATA As String
    Dim kolomnaamProjectNrDATA As String
    Dim kolomnaamProductnrDATA As String
    Dim kolomnaamAfwijkingManUrenDATA As String
    Dim kolomnaamAfwijkingMachUrenDATA As String
    Dim rijnummerEersteData As Integer
    
    'Variabelen met betrekking tot werkblad data vullen
    werkbladnaamDATA = "Data"
    kolomnaamProjectNrDATA = "A"
    kolomnaamProductnrDATA = "B"
    kolomnaamAfwijkingManUrenDATA = "I"
    kolomnaamAfwijkingMachUrenDATA = "J"
    rijnummerEersteData = 2
    
    'Variabelen met betrekking tot werkblad afwijkingen
    Dim werkbladnaamAfwijking As String
    Dim kolomnaamProjectNrAFWIJKING As String
    Dim kolomnaamAfwijkingManUrenAFWIJKING As String
    Dim kolomnaamAfwijkingMachUrenAFWIJKING As String
    Dim rijnummerEersteAfwijking As Integer
    
    'Variabelen met betrekking tot werkblad data vullen
    werkbladnaamAfwijking = "Afwijkingenblad"
    kolomnaamToegestaneAfwijking = "E"
    kolomnaamProjectNrAFWIJKING = "B"
    kolomnaamAfwijkingManUrenAFWIJKING = "J"
    kolomnaamAfwijkingMachUrenAFWIJKING = "K"
    rijnummerEersteAfwijking = 6
    rijnummerToegestaneAfwijkingMan = 2
    rijnummerToegestaneAfwijkingMach = 3
    
    'Tellers aanmaken
    Dim tellerHaalGegevensTemp As Integer
    Dim tellerTotaalAantalRijen As Integer
    Dim tellerToonUitvoerTemp As Integer
    Dim tellerHuidigeUitvoerRij As Integer
    Dim tellerArray As Integer
    
    'Tellers vullen
    tellerHaalGegevensTemp = rijnummerEersteData
    tellerTotaalAantalRijen = 0
    tellerArray = 0
    tellerToonUitvoerTemp = rijnummerEersteData
    tellerHuidigeUitvoerRij = rijnummerEersteAfwijking
    
    'Rest
    toegestaneAfwijkingMan = CDbl(Range(werkbladnaamAfwijking & "!" & kolomnaamToegestaneAfwijking & rijnummerToegestaneAfwijkingMan).Value)
    toegestaneAfwijkingMach = CDbl(Range(werkbladnaamAfwijking & "!" & kolomnaamToegestaneAfwijking & rijnummerToegestaneAfwijkingMach).Value)
    toegestaneAfwijkingManNegatief = "-" & toegestaneAfwijkingMan
    toegestaneAfwijkingMachNegatief = "-" & toegestaneAfwijkingMach

    'Tel het aantal rijen dat er aan gegevens zijn
    Do While alleGegevensGehad = False
    
        'Controleren als de desbetreffende cel leeg is
        If Range(werkbladnaamDATA & "!" & kolomnaamProjectNrDATA & tellerHaalGegevensTemp).Value = Empty Or Range(werkbladnaamDATA & "!" & kolomnaamProjectNrDATA & tellerHaalGegevensTemp).Value = 0 Then
        
            'Alle rijen in de data werkblad zijn geteld.
            alleGegevensGehad = True
            
        Else
        
            'Aantel gegevens dat in de Data werkblad staat verhogen
            tellerTotaalAantalRijen = tellerTotaalAantalRijen + 1
        
            'Teller van de huidige data rij verhogen
            tellerHaalGegevensTemp = tellerHaalGegevensTemp + 1
            
        End If 'Einde if
        
    Loop 'Einde while

    'Variabel aanmaken voor unieke productnr's
    Dim uniekeProductnr() As String
    ReDim uniekeProductnr(tellerTotaalAantalRijen) As String

    'Leeg de rijen die er nu staan
    Range(werkbladnaamAfwijking & "!" & kolomnaamProjectNrAFWIJKING & rijnummerEersteAfwijking & ":" & werkbladnaamAfwijking & "!" & kolomnaamAfwijkingMachUrenAFWIJKING & "999999").Value = ""

    Do While alleUitvoerGehad = False
    
        'Maak variabelen
        Dim afwijkingMan As Double
        Dim afwijkingMach As Double
        
        'Vul variabelen
        afwijkingMan = Range(werkbladnaamDATA & "!" & kolomnaamAfwijkingManUrenDATA & tellerToonUitvoerTemp).Value
        afwijkingMach = Range(werkbladnaamDATA & "!" & kolomnaamAfwijkingMachUrenDATA & tellerToonUitvoerTemp).Value

        'Controleer afwijking
        If afwijkingMan >= toegestaneAfwijkingMan Or afwijkingMan <= toegestaneAfwijkingManNegatief And afwijkingMach >= toegestaneAfwijkingMach Or afwijkingMach <= toegestaneAfwijkingMachNegatief Then

            If sorteerOpUniekeProductnr = False Then

            'Rij kopieeren
            Range(werkbladnaamAfwijking & "!" & kolomnaamProjectNrAFWIJKING & tellerHuidigeUitvoerRij & _
            ":" & werkbladnaamAfwijking & "!" & kolomnaamAfwijkingMachUrenAFWIJKING & tellerHuidigeUitvoerRij).Value = Range(werkbladnaamDATA & _
            "!" & kolomnaamProjectNrDATA & tellerToonUitvoerTemp & ":" & werkbladnaamDATA & "!" & kolomnaamAfwijkingMachUrenDATA & tellerToonUitvoerTemp).Value
        
            'Productnr toevoegen aan array
            uniekeProductnr(tellerArray) = Range(werkbladnaamDATA & "!" & kolomnaamProductnrDATA & tellerHuidigeUitvoerRij).Value
        
            'Teller verhogen
            tellerHuidigeUitvoerRij = tellerHuidigeUitvoerRij + 1
        
            Else
            
                If InArray(Range(werkbladnaamDATA & "!" & kolomnaamProductnrDATA & tellerToonUitvoerTemp).Value, uniekeProductnr) = False Then
            
                    'Rij kopieeren
                    Range(werkbladnaamAfwijking & "!" & kolomnaamProjectNrAFWIJKING & tellerHuidigeUitvoerRij & _
                    ":" & werkbladnaamAfwijking & "!" & kolomnaamAfwijkingMachUrenAFWIJKING & tellerHuidigeUitvoerRij).Value = Range(werkbladnaamDATA & _
                    "!" & kolomnaamProjectNrDATA & tellerToonUitvoerTemp & ":" & werkbladnaamDATA & "!" & kolomnaamAfwijkingMachUrenDATA & tellerToonUitvoerTemp).Value
                
                    'Productnr toevoegen aan array
                    uniekeProductnr(tellerArray) = Range(werkbladnaamDATA & "!" & kolomnaamProductnrDATA & tellerToonUitvoerTemp).Value
                
                    'Teller verhogen
                    tellerHuidigeUitvoerRij = tellerHuidigeUitvoerRij + 1
                    tellerArray = tellerArray + 1
            
                End If
            
            End If
        
        End If

        'Teller verhogen
        tellerToonUitvoerTemp = tellerToonUitvoerTemp + 1
        
        'Alle rijen gehad?
        If tellerToonUitvoerTemp + 1 > tellerTotaalAantalRijen + rijnummerEersteData Then
            alleUitvoerGehad = True
        End If
    
    Loop
    
End Sub

Function InArray(thevalue, thearray) As Boolean

    'Variabel aanmaken
    Dim tellertje As Integer

    'Alle array items langsgaan
    For tellertje = LBound(thearray) To UBound(thearray)
    
        'Komt waarde overeen, stop dan
        If CStr(thevalue) = CStr(thearray(tellertje)) Then
        
            InArray = True
            Exit Function
        
        End If 'einde if
    
    Next 'einde for

    'Niks gevonden
    InArray = False
     
End Function

Ergens zit een enorme fout in de code. Verder denk ik trouwens dat deze code véél te complex is...

Ik zal nog even proberen het voorbeeld te verduidelijken. Hoop echt dat jullie mij weer kunnen helpen...

Mvg,
Jelle
 
Een vriend van me heeft het opgelost!

Code: 
Sub filter()

    'Algemene variabelen
    Dim alleGegevensGehad As Boolean
    Dim alleUitvoerGehad As Boolean
    Dim sorteerOpUniekeProductnr As Boolean
    Dim toegestaneAfwijkingMan As Double
    Dim toegestaneAfwijkingMach As Double
    Dim toegestaneAfwijkingManNegatief As Double
    Dim toegestaneAfwijkingMachNegatief As Double
    
    'Algemene variabelen instellen
    alleGegevensGehad = False
    alleUitvoerGehad = False
    sorteerOpUniekeProductnr = True

    'Variabelen met betrekking tot werkblad data
    Dim werkbladnaamDATA As String
    Dim kolomnaamProjectNrDATA As String
    Dim kolomnaamProductnrDATA As String
    Dim kolomnaamAfwijkingManUrenDATA As String
    Dim kolomnaamAfwijkingMachUrenDATA As String
    Dim rijnummerEersteData As Integer
    
    'Variabelen met betrekking tot werkblad data vullen
    werkbladnaamDATA = "Data"
    kolomnaamProjectNrDATA = "A"
    kolomnaamProductnrDATA = "B"
    kolomnaamAfwijkingManUrenDATA = "I"
    kolomnaamAfwijkingMachUrenDATA = "J"
    rijnummerEersteData = 2
    
    'Variabelen met betrekking tot werkblad afwijkingen
    Dim werkbladnaamAfwijking As String
    Dim kolomnaamProjectNrAFWIJKING As String
    Dim kolomnaamAfwijkingManUrenAFWIJKING As String
    Dim kolomnaamAfwijkingMachUrenAFWIJKING As String
    Dim rijnummerEersteAfwijking As Integer
    
    'Variabelen met betrekking tot werkblad data vullen
    werkbladnaamAfwijking = "Afwijkingenblad"
    kolomnaamToegestaneAfwijking = "E"
    kolomnaamProjectNrAFWIJKING = "B"
    kolomnaamAfwijkingManUrenAFWIJKING = "J"
    kolomnaamAfwijkingMachUrenAFWIJKING = "K"
    rijnummerEersteAfwijking = 6
    rijnummerToegestaneAfwijkingMan = 2
    rijnummerToegestaneAfwijkingMach = 3
    
    'Tellers aanmaken
    Dim tellerHaalGegevensTemp As Integer
    Dim tellerTotaalAantalRijen As Integer
    Dim tellerToonUitvoerTemp As Integer
    Dim tellerHuidigeUitvoerRij As Integer
    Dim tellerArray As Integer
    
    'Tellers vullen
    tellerHaalGegevensTemp = rijnummerEersteData
    tellerTotaalAantalRijen = 0
    tellerArray = 0
    tellerToonUitvoerTemp = rijnummerEersteData
    tellerHuidigeUitvoerRij = rijnummerEersteAfwijking
    
    'Rest
    toegestaneAfwijkingMan = CDbl(Range(werkbladnaamAfwijking & "!" & kolomnaamToegestaneAfwijking & rijnummerToegestaneAfwijkingMan).Value)
    toegestaneAfwijkingMach = CDbl(Range(werkbladnaamAfwijking & "!" & kolomnaamToegestaneAfwijking & rijnummerToegestaneAfwijkingMach).Value)
    toegestaneAfwijkingManNegatief = "-" & toegestaneAfwijkingMan
    toegestaneAfwijkingMachNegatief = "-" & toegestaneAfwijkingMach

    'Tel het aantal rijen dat er aan gegevens zijn
    Do While alleGegevensGehad = False
    
        'Controleren als de desbetreffende cel leeg is
        If Range(werkbladnaamDATA & "!" & kolomnaamProjectNrDATA & tellerHaalGegevensTemp).Value = Empty Or Range(werkbladnaamDATA & "!" & kolomnaamProjectNrDATA & tellerHaalGegevensTemp).Value = 0 Then
        
            'Alle rijen in de data werkblad zijn geteld.
            alleGegevensGehad = True
            
        Else
        
            'Aantel gegevens dat in de Data werkblad staat verhogen
            tellerTotaalAantalRijen = tellerTotaalAantalRijen + 1
        
            'Teller van de huidige data rij verhogen
            tellerHaalGegevensTemp = tellerHaalGegevensTemp + 1
            
        End If 'Einde if
        
    Loop 'Einde while

    'Variabel aanmaken voor unieke productnr's
    Dim uniekeProductnr() As String
    ReDim uniekeProductnr(tellerTotaalAantalRijen) As String

    'Leeg de rijen die er nu staan
    Range(werkbladnaamAfwijking & "!" & kolomnaamProjectNrAFWIJKING & rijnummerEersteAfwijking & ":" & werkbladnaamAfwijking & "!" & kolomnaamAfwijkingMachUrenAFWIJKING & "999999").Value = ""

    Do While alleUitvoerGehad = False
    
        'Maak variabelen
        Dim afwijkingMan As Double
        Dim afwijkingMach As Double
        
        'Vul variabelen
        afwijkingMan = Range(werkbladnaamDATA & "!" & kolomnaamAfwijkingManUrenDATA & tellerToonUitvoerTemp).Value
        afwijkingMach = Range(werkbladnaamDATA & "!" & kolomnaamAfwijkingMachUrenDATA & tellerToonUitvoerTemp).Value

        'Controleer afwijking
      If (afwijkingMan >= toegestaneAfwijkingMan Or afwijkingMan <= toegestaneAfwijkingManNegatief) And (afwijkingMach >= toegestaneAfwijkingMach Or afwijkingMach <= toegestaneAfwijkingMachNegatief) Then

            If sorteerOpUniekeProductnr = False Then

            'Rij kopieeren
            Range(werkbladnaamAfwijking & "!" & kolomnaamProjectNrAFWIJKING & tellerHuidigeUitvoerRij & _
            ":" & werkbladnaamAfwijking & "!" & kolomnaamAfwijkingMachUrenAFWIJKING & tellerHuidigeUitvoerRij).Value = Range(werkbladnaamDATA & _
            "!" & kolomnaamProjectNrDATA & tellerToonUitvoerTemp & ":" & werkbladnaamDATA & "!" & kolomnaamAfwijkingMachUrenDATA & tellerToonUitvoerTemp).Value
        
            'Productnr toevoegen aan array
            uniekeProductnr(tellerArray) = Range(werkbladnaamDATA & "!" & kolomnaamProductnrDATA & tellerHuidigeUitvoerRij).Value
        
            'Teller verhogen
            tellerHuidigeUitvoerRij = tellerHuidigeUitvoerRij + 1
        
            Else
            
                If InArray(Range(werkbladnaamDATA & "!" & kolomnaamProductnrDATA & tellerToonUitvoerTemp).Value, uniekeProductnr) = False Then
            
                    'Rij kopieeren
                    Range(werkbladnaamAfwijking & "!" & kolomnaamProjectNrAFWIJKING & tellerHuidigeUitvoerRij & _
                    ":" & werkbladnaamAfwijking & "!" & kolomnaamAfwijkingMachUrenAFWIJKING & tellerHuidigeUitvoerRij).Value = Range(werkbladnaamDATA & _
                    "!" & kolomnaamProjectNrDATA & tellerToonUitvoerTemp & ":" & werkbladnaamDATA & "!" & kolomnaamAfwijkingMachUrenDATA & tellerToonUitvoerTemp).Value
                
                    'Productnr toevoegen aan array
                    uniekeProductnr(tellerArray) = Range(werkbladnaamDATA & "!" & kolomnaamProductnrDATA & tellerToonUitvoerTemp).Value
                
                    'Teller verhogen
                    tellerHuidigeUitvoerRij = tellerHuidigeUitvoerRij + 1
                    tellerArray = tellerArray + 1
            
                End If
            
            End If
        
        End If

        'Teller verhogen
        tellerToonUitvoerTemp = tellerToonUitvoerTemp + 1
        
        'Alle rijen gehad?
        If tellerToonUitvoerTemp + 1 > tellerTotaalAantalRijen + rijnummerEersteData Then
            alleUitvoerGehad = True
        End If
    
    Loop
    
End Sub

Function InArray(thevalue, thearray) As Boolean

    'Variabel aanmaken
    Dim tellertje As Integer

    'Alle array items langsgaan
    For tellertje = LBound(thearray) To UBound(thearray)
    
        'Komt waarde overeen, stop dan
        If CStr(thevalue) = CStr(thearray(tellertje)) Then
        
            InArray = True
            Exit Function
        
        End If 'einde if
    
    Next 'einde for

    'Niks gevonden
    InArray = False
     
End Function

Ik zet 'm op opgelost. Alle mensen die zich op mijn probleem hebben gestort wil ik hartstikke bedanken.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan