Hoe exception maken ?

Status
Niet open voor verdere reacties.

VeerleVR

Gebruiker
Lid geworden
5 aug 2011
Berichten
38
Hoi,

Ik heb een excelbestand met 4 draaitabellen.
De eerste 3 draaitabellen zijn gelinkt aan elkaar via codes zodat als je bij 1 van de 3 een filter aanpast ze allemaal automatisch mee updaten.

De 4e mag echter niet gelinkt worden aan de eerste 3 omdat deze andere gegevens bevat. Hoe kan ik dit oplossen ?

Dit is de code :
Code:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Application.EnableEvents = False
Dim Pt As PivotTable, choice As String
 
For Each Pt In ActiveSheet.PivotTables
[COLOR=royalblue]Dit is de eerste filter[/COLOR]
If Pt.Name <> Target.Name Then
choice = Target.PivotFields("Client").CurrentPage
Pt.PivotFields("Client").CurrentPage = choice
End If
[COLOR=royalblue]Dit is de tweede filter[/COLOR]
If Pt.Name <> Target.Name Then
choice = Target.PivotFields("Category").CurrentPage
Pt.PivotFields("Category").CurrentPage = choice
End If
[COLOR=royalblue]Dit is de derde filter[/COLOR]
If Pt.Name <> Target.Name Then
choice = Target.PivotFields("Value").CurrentPage
Pt.PivotFields("Value").CurrentPage = choice
End If
[COLOR=royalblue]Dit zijn 3 filters van de 4e draaitabel (die dus andere data bevat)[/COLOR]
If Pt.Name <> Target.Name Then
choice = Target.PivotFields("Client GP").Draaitabel4
Pt.PivotFields("Client GP").Draaitabel1 = choice
End If
If Pt.Name <> Target.Name Then
choice = Target.PivotFields("Category GP").Draaitabel4
Pt.PivotFields("Category GP").Draaitabel1 = choice
End If
If Pt.Name <> Target.Name Then
choice = Target.PivotFields("Value GP").Draaitabel4
Pt.PivotFields("Value GP").Draaitabel1 = choice
End If
 
Pt.Update
Next Pt
Application.EnableEvents = True
Cells.EntireColumn.AutoFit
 
Laatst bewerkt door een moderator:
1) Dit is voor het VBA forum, niet VB.
2) de oplossing is afhankelijk hoe de verschillende bladen zich verhouden tussen de tabellen.

In principe selecteer je nu de "pagina" van de target en pas je de tabel aan naar dezelfde pagina. Indien de pagina's zich 1 op 1 verhouden kan de zelfde code gehandhaafd worden als van de andere tabellen ook al is de informatie anders.
 
Daarom verplaatst. Volgende keer goed opletten waar je je vraag plaatst
 
Je hebt nog steeds niet verteld wat er wel moet gebeuren?

Wat ik lees: indien je iets in 1 t/m 3 veranderd moet 4 niet veranderen. Indien iets in 4 veranderd moeten 1 t/m 3 wel veranderen?

Ik kan precies begrijpen wat deze code doet, maar niet wat WEL de bedoeling is ;)
 
Sorry het is ook moeilijk om goed proberen uit te leggen :)

Het is zo :
indien je iets in 1 t/m 3 veranderd moet 4 niet veranderen. Indien iets in 4 veranderd moeten 1 t/m 3 ook NIETveranderen.
4 zou los van de eerste 3 moeten staan maar ik vind de juiste code niet ...

Groetjes
 
Als ik in de code voor tabel 4 kijk:

Code:
If Pt.Name <> Target.Name Then
choice = Target.PivotFields("Client GP").Draaitabel4
Pt.PivotFields("Client GP").Draaitabel1 = choice
End If

Dan wordt volgens mij toch echt tabel 1 aangepast. Op zich kun je het uitzonderen op een aantal manieren aanpakken.

Indien er niet meer tabellen bijkomen kun je in plaats van een for each een gewone for loop gebruiken. Je kunt via "target" zien of het een bewerking is in de eerste drie tabellen of tabel 4. Je kunt ook de for each loop houden en dan kun je de IF statement aanpassen.

Bijvoorbeeld

Code:
if (pt.name<> target name) and target.name <> "Draaitabel4" then
 
Laatst bewerkt door een moderator:
Bedoel je :

PHP:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Application.EnableEvents = False
    Dim Pt As PivotTable, choice As String
    For Each Pt In ActiveSheet.PivotTables
        If (Pt.Name <> Target.Name) And Target.Name <> "Draaitabel4" Then
             choice = Target.PivotFields("Client").CurrentPage
             Pt.PivotFields("Client").CurrentPage = choice
        End If
        If (Pt.Name <> Target.Name) And Target.Name <> "Draaitabel4" Then
             choice = Target.PivotFields("Category").CurrentPage
             Pt.PivotFields("Category").CurrentPage = choice
        End If
       If (Pt.Name <> Target.Name) And Target.Name <> "Draaitabel4" Then
             choice = Target.PivotFields("Value").CurrentPage
             Pt.PivotFields("Value").CurrentPage = choice
        End If
        If (Pt.Name <> Target.Name) And Target.Name <> "Draaitabel4" Then
             choice = Target.PivotFields("Client GP").Draaitabel4
             Pt.PivotFields("Client GP").CurrentPage = choice
        End If
        If (Pt.Name <> Target.Name) And Target.Name <> "Draaitabel4" Then
             choice = Target.PivotFields("Category GP").Draaitabel4
             Pt.PivotFields("Category GP").CurrentPage = choice
        End If
       If (Pt.Name <> Target.Name) And Target.Name <> "Draaitabel4" Then
             choice = Target.PivotFields("Value GP").Draaitabel4
             Pt.PivotFields("Value GP").CurrentPage = choice
        End If
        Pt.Update
    Next Pt
Application.EnableEvents = True
Cells.EntireColumn.AutoFit
End Sub


Want dit lukt niet ...
By the way : Client, Category + Value horen bij de 3 draaitabellen,
Client GP, Category GP + Value GP horen bij de 4e draaitabel en moeten dus apart werken ...
 
Kun je eventueel het volgende eens laten lopen? Ik gok hier natuurlijk dat draaitabel 4 ook "Draaitabel4" heet, maar als je die een naam hebt gegeven moet de and clausule natuurlijk de juiste naam bevatten.

Code:
For Each Pt In ActiveSheet.PivotTables
msgbox (Pt.name)
next pt
 
Je hebt gelijk ze heten zo :
Draaitabel1 = Monthly Forecast
Draaitabel2= Monthly Estimate Base
Draaitabel3= Monthly Estimate Growth
Draaitabel4= Draaitabel1

Moet ik het bestand anders even doorsturen ?
(als je me verteld hoe)
 
Je kunt je bovenstaande code aanpassen naar name <> "Draaitabel1" in ieder geval. Als het dan niet werkt kan ik wel even verder kijken, maar alleen als er geen gevoelige informatie instaat en als er geen andere oplossing is. Oplossingen worden natuurlijk het liefst uitgewisseld via het forum zodat iedereen de oplossing kan zien.
 
Ik hoor je maar het lukt niet ... sorry !

Kan ik het je doorsturen ?
Zo ja, hoe doe je dat dan?
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan