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

Na inlezen vanuit Sharepoint, per bedrijfsonderdeel een grafiek genereren

Status
Niet open voor verdere reacties.
A

Appievee

Gebruiker
Lid geworden
15 jul 2010
Berichten
83
Beste Forummers,

Op m'n werk vanuit een Sharepoint omgeving gegevens exporteren naar Excel.

Vanuit deze gegevens wil snel en automatisch per bedrijfsonderdeel een grafiek genereren. Hopelijk spreekt de bijlage voor zich.

Alvast bedankt voor de hulp,

Albert
 

Bijlagen

Via macorecorder kun je alle handelingen opnemen daarna deze macro aan een knop verbinden en klaar is Albert.
 
Bedankt voor het antwoord.

Ik had al enkele pogingen ondernomen zonder het gewenste resultaat.
Ook heb ik begrip voor dat 'luiigheid' niet gestimuleerd wordt op dit forum :thumb:.

Dus bij deze, hier mijn laatste probeersel met behulp van marco-opnemen.
Het werkt zolang ik de bron (blad Invoer) niet wijzig.

Echter zit nu in de macro in de array de namen van de oorspronkelijke filtering en die houdt dit vast.

Bovendien vraag ik mij af of er niet een andere manier is om de gegevens in te lezen vanuit 'invoer). Ik maak nu gebruik van vert.zoek functie.

Wie o wie, kan mij op het juiste spoor helpen.

Albert
 

Bijlagen

Bedankt voor het antwoord.

Ik had al enkele pogingen ondernomen zonder het gewenste resultaat.
Ook heb ik begrip voor dat 'luiigheid' niet gestimuleerd wordt op dit forum :thumb:.

Dus bij deze, hier mijn laatste probeersel met behulp van marco-opnemen.
Het werkt zolang ik de bron (blad Invoer) niet wijzig.

Echter zit nu in de macro in de array de namen van de oorspronkelijke filtering en die houdt dit vast.

Bovendien vraag ik mij af of er niet een andere manier is om de gegevens in te lezen vanuit 'invoer). Ik maak nu gebruik van vert.zoek functie.

Wie o wie, kan mij op het juiste spoor helpen.

Albert
 
Code: 
Sub bedrijfA()
'
' bedrijfA Macro
'

'
    ActiveSheet.Range("$A$6:$D$37").AutoFilter Field:=2, Criteria1:="A"
    Range("A13:D60").Select
    Selection.Copy
    Sheets("OnderdeelA").Select
    Range("A7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("OnderdeelA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("OnderdeelA").Sort.SortFields.Add Key:=Range( _
        "D7:D42"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("OnderdeelA").Sort.SortFields.Add Key:=Range( _
        "C7:C42"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("OnderdeelA").Sort
        .SetRange Range("A6:D42")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Deze macro heb ik voor je opgenomen.
 
Merci voor de input.

Ik heb je macro overgenomen en ingevoerd.
Het werkt echter niet naar behoren (alles wordt weggefilterd, zie bijlage).

Ik kan echter de oorzaak niet achterhalen in de code.

Verder valt mij op dat sheet range in dit geval gefixeerd is middels $A$6:$D$37.
Het aantal regels van de invoer zal echter wisselend zijn (zal oplopen naar ca. 500). Ik verwacht dat dit niet goed zal gaan.

Verder heb ik gekeken of het met behulp van draaitabellen en grafieken kan. Maar de gebruikte grafiek wordt daar niet door ondersteund. De grafieken die daar wel mee communiceren zijn niet geschikt voor het verhaal dat ik wil laten zien.

Hulp wordt dus nog altijd op prijs gesteld :)

Albert
 

Bijlagen

alles wordt weggefilterd
Klik om te vergroten...

Dat alles weggefilterd wordt is toch de bedoeling, je wilt toch alleen OnderdeelA zien?

Er wordt een filter gemaakt op onderdeelA dit geheel wordt gekopieerd naar het tabblad OnderdeelA en gesorteerd en dan wordt van de bovenste 3 waarden een grafiek gemaakt.

Dit begreep ik tenminste uit je vraag.
Verder valt mij op dat sheet range in dit geval gefixeerd is middels $A$6:$D$37.
Het aantal regels van de invoer zal echter wisselend zijn (zal oplopen naar ca. 500).
Klik om te vergroten...
Het bereik kun je zelf aanpassen. Dit bereik is slechts een voorbeeld.
Mijn glazen bol vertelde mij niet dat het bereik kon oplopen tot 500 regels.
 

Bijlagen

Dag Willem,

Dit ziet er helemaal top uit! En het produceert precies zoals ik het hebben wil.

Ik zal het her en der nog wat moeten bijsleutelen/ombouwen naar de echte situatie, maar dit helpt mij zeker een heel goed op weg. Dus ik zal de boel nog goed moeten snappen wat er allemaal gebeurt, maar daar ga ik werk van maken.

Bedankt voor je hulp!!

Albert
 
De macro van Willem heeft me inderdaad op weg geholpen. Inmiddels de boel ingebouwd.


Code: 
Sub bedrijfA()
'
' bedrijfA Macro
'

'
    ActiveSheet.Range("$A$6:$u$200").AutoFilter Field:=2, Criteria1:="A"
    Range("A7:U200").Select
    Selection.Copy
    Sheets("OnderdeelA").Select
    Range("A7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("OnderdeelA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("OnderdeelA").Sort.SortFields.Add Key:=Range( _
        "D7:D200"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("OnderdeelA").Sort.SortFields.Add Key:=Range( _
        "C7:C200"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("OnderdeelA").Sort
        .SetRange Range("A6:D50")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Omdat de range een stuk groter is wil ik zo weinig mogelijk gegevens naar "OnderdeelA" kopieren en vervolgens sorteren. De wens juist alleen de gegevens uit kolom A, B, Q en U die wel aan het criterium "A" voldoen.

Ik probeer het via onderstaande, maar dan selecteert en kopiert ie regels 7 t/m 200. Terwijl ik alleen de gefilterde items wil.
Code: 
Sub bedrijfA()
'
' bedrijfA Macro
'

'
    ActiveSheet.Range("$A$6:$u$200").AutoFilter Field:=2, Criteria1:="A"
    [B]Range("A7:B200,Q7:Q200,U7:U200").Select[/B]    Selection.Copy
    Sheets("OnderdeelA").Select
    Range("A7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("OnderdeelA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("OnderdeelA").Sort.SortFields.Add Key:=Range( _
        "D7:D200"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("OnderdeelA").Sort.SortFields.Add Key:=Range( _
        "C7:C200"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("OnderdeelA").Sort
        .SetRange Range("A6:D50")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Wat doe ik verkeerd? :o


Albert
 
Code: 
    ActiveSheet.Range("$A$6:$u$200").AutoFilter Field:=2, Criteria1:="A"
    Range("A7:B200,Q7:Q200,U7:U200").Select   [COLOR="red"] Selection.Copy[/COLOR]


    ActiveSheet.Range("$A$6:$u$200").AutoFilter Field:=2, Criteria1:="A"
    Range("A7:B200,Q7:Q200,U7:U200").Select    
   [COLOR="red"] Selection.Copy[/COLOR]

En als je Selection.Copy nu op de volgende regel zet.
 
Dat kwam door mijn slechte knip en plakwerk.
Hij stond wel al zo in de macro

Ik denk dat ik de fout ontdekt heb: zat 'm in de .SetRange Range("A6:D7")

Morgen nog uitgebreid testen.

Code: 
Sub bedrijfA()
'
' bedrijfA Macro
'

'
    ActiveSheet.Range("$A$6:$u$200").AutoFilter Field:=2, Criteria1:="A"
    Range("A7:B200,Q7:Q200,U7:U200").Select
    Selection.Copy
    Sheets("OnderdeelA").Select
    Range("A7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("OnderdeelA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("OnderdeelA").Sort.SortFields.Add Key:=Range( _
        "D7:D200"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("OnderdeelA").Sort.SortFields.Add Key:=Range( _
        "C7:C200"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("OnderdeelA").Sort
        .SetRange Range("A6:D7")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Wordt hopelijk niet meer vervolgd :confused:
 
Na wat testwerk toch nog aanpassingen gedaan.
Omdat de lijst wisselend van lengte is, werd niet in alle testen goed gesorteerd.

Door in dit geval alle ranges op te rekken naar regel 200 en vervolgens de lege regels te filteren, heb ik het werkend gekregen.



Code: 
Sub bedrijfA()
'
' bedrijfA Macro
'

'
    ActiveSheet.Range("$A$6:$u$200").AutoFilter Field:=2, Criteria1:="A"
    Range("A7:B200,Q7:Q200,U7:U200").Select
    Selection.Copy
    Sheets("OnderdeelA").Select
    Range("A7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("OnderdeelA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("OnderdeelA").Sort.SortFields.Add Key:=Range( _
        "D7:D200"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("OnderdeelA").Sort.SortFields.Add Key:=Range( _
        "C7:C200"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
        Selection.AutoFilter
    ActiveSheet.Range("$A$6:$D$200").AutoFilter Field:=4, Criteria1:="<>"
    With ActiveWorkbook.Worksheets("OnderdeelA").Sort
        .SetRange Range("A6:D200")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Wellicht zijn er mooiere oplossingen, maar voor mij werkt het!

Albert
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan