Försök att finna en loop som kan korta ner min VBA kod.

L

Loranga

New Member
Joined
Jan 30, 2007
Messages
36
Aloha,

Jag har ett ark där jag kan styra en pivotttabell med hjälp av knappar på arket.
Jag väljer med hjälp av en rullknapp vilken vecka som ska visas i tabellen.
Jag har två optionbuttons som styr om jag ska visa en enskild vecka eller visa accumulerade veckor till och med den valda veckan.

Jag skulle behöva hjälp med att skapa någon form av loop eller räknare som kortar ner den här koden (eftersom jag ska bygga ut den med 52 nummer).

Code: 
Sub Makro1()

Application.ScreenUpdating = False
    Dim Singleweek_or_Accumulated As Integer
    Dim Week_number As Integer
    
    Singleweek_or_Accumulated = Range("J27")
'   if J27 is = 1 the I will show singel week in the table
'   if J27 is = 2 the I will show accumulated weeks in the table
    
    Week_number = Range("J29")
'   J29 is the cell where i select the week number
    
    If Singleweek_or_Accumulated = 1 Then
    ' singel week scenario
     With ActiveSheet.PivotTables("Pivottabell5").PivotFields("Week")
     .PivotItems("10").Visible = True
        .PivotItems("11").Visible = True
        .PivotItems("12").Visible = True
        .PivotItems("13").Visible = True
        .PivotItems("14").Visible = True
        .PivotItems("15").Visible = True
    End With
    
      With ActiveSheet.PivotTables("Pivottabell5").PivotFields("Week")
    Select Case Week_number
  
         Case Is = 10
        .PivotItems("10").Visible = True
        .PivotItems("11").Visible = False
        .PivotItems("12").Visible = False
        .PivotItems("13").Visible = False
        .PivotItems("14").Visible = False
        .PivotItems("15").Visible = False
        
       Case Is = 11
        .PivotItems("10").Visible = False
        .PivotItems("11").Visible = True
        .PivotItems("12").Visible = False
        .PivotItems("13").Visible = False
        .PivotItems("14").Visible = False
        .PivotItems("15").Visible = False
        
         Case Is = 12
        .PivotItems("10").Visible = False
        .PivotItems("11").Visible = False
        .PivotItems("12").Visible = True
        .PivotItems("13").Visible = False
        .PivotItems("14").Visible = False
        .PivotItems("15").Visible = False
        
         Case Is = 13
        .PivotItems("10").Visible = False
        .PivotItems("11").Visible = False
        .PivotItems("12").Visible = False
        .PivotItems("13").Visible = True
        .PivotItems("14").Visible = False
        .PivotItems("15").Visible = False
        
        Case Is = 14
        .PivotItems("10").Visible = False
        .PivotItems("11").Visible = False
        .PivotItems("12").Visible = False
        .PivotItems("13").Visible = False
        .PivotItems("14").Visible = True
        .PivotItems("15").Visible = False
        
         Case Is = 15
        .PivotItems("10").Visible = False
        .PivotItems("11").Visible = False
        .PivotItems("12").Visible = False
        .PivotItems("13").Visible = False
        .PivotItems("14").Visible = False
        .PivotItems("15").Visible = True
               
        End Select
        
   End With
   
   End If
   
   If Singleweek_or_Accumulated = 2 Then
   ' accumulated weeks scenario
   
    With ActiveSheet.PivotTables("Pivottabell5").PivotFields("Week")
     .PivotItems("10").Visible = True
        .PivotItems("11").Visible = True
        .PivotItems("12").Visible = True
        .PivotItems("13").Visible = True
        .PivotItems("14").Visible = True
        .PivotItems("15").Visible = True
    End With
    
      With ActiveSheet.PivotTables("Pivottabell5").PivotFields("Week")
    Select Case Week_number
  
         Case Is = 10
        .PivotItems("10").Visible = True
        .PivotItems("11").Visible = False
        .PivotItems("12").Visible = False
        .PivotItems("13").Visible = False
        .PivotItems("14").Visible = False
        .PivotItems("15").Visible = False
        
       Case Is = 11
        .PivotItems("10").Visible = True
        .PivotItems("11").Visible = True
        .PivotItems("12").Visible = False
        .PivotItems("13").Visible = False
        .PivotItems("14").Visible = False
        .PivotItems("15").Visible = False
        
         Case Is = 12
        .PivotItems("10").Visible = True
        .PivotItems("11").Visible = True
        .PivotItems("12").Visible = True
        .PivotItems("13").Visible = False
        .PivotItems("14").Visible = False
        .PivotItems("15").Visible = False
        
         Case Is = 13
        .PivotItems("10").Visible = True
        .PivotItems("11").Visible = True
        .PivotItems("12").Visible = True
        .PivotItems("13").Visible = True
        .PivotItems("14").Visible = False
        .PivotItems("15").Visible = False
        
        Case Is = 14
        .PivotItems("10").Visible = True
        .PivotItems("11").Visible = True
        .PivotItems("12").Visible = True
        .PivotItems("13").Visible = True
        .PivotItems("14").Visible = True
        .PivotItems("15").Visible = False
        
         Case Is = 15
        .PivotItems("10").Visible = True
        .PivotItems("11").Visible = True
        .PivotItems("12").Visible = True
        .PivotItems("13").Visible = True
        .PivotItems("14").Visible = True
        .PivotItems("15").Visible = True
        
        End Select
        
   End With
   End If
   

End Sub
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Sort by date Sort by votes
Hej,

Du kan väl prova med t.ex

Code: 
For x = 10 To 52
      With ActiveSheet.PivotTables("Pivottabell5").PivotFields("Week")
        If x >= Week_number Then
            .PivotItems("" & x).Visible = False
        Else
            .PivotItems("" & x).Visible = True
        End If
      End With
Next x

för alternativet med 1 i J27 och:

Code: 
For x = 10 To 52
      With ActiveSheet.PivotTables("Pivottabell5").PivotFields("Week")
        If x <> Week_number Then
            PivotItems("" & x).Visible = False
        Else
            .PivotItems("" & x).Visible = True
        End If
      End With
Next x

då du har en tvåa.
 
Upvote 0
Tack för ditt svar,

Jag får det inte att fungera riktigt då jag får körfel 1004 "Egenskapen Visible går inte att ange för klassen PivotItem". Nu har jag en veckas semester att fundera på vad sdet kan vara som strular.
 
Upvote 0
Det beror på att du inte har alla veckor i tabellen än. Jag loopar ju 10 till 52. Ändra till de veckor du verkligen har.

Jag såg också att jag glömde en punkt framför fösta PivotItems i andra kodsnutten.
 
Upvote 0
Hej punkten hittade jag. Jag ska prova att lägga in alla veckor. Saken är den att jag kommer att skapa tabellen från enlista som jag kommer att uppdatera veckovis under året. Då jag inte vill ändra koden vara vecka kanske jag ska börja med att lägga in "dummy" rader i tabellen med veckorna 1-52.
 
Upvote 0
Efter några justeringar fungerar det! Än en gång är jag imponerad över dina snabba och korrekta lösningar.

Jag har lagt in tomma rader med veckonummer 1-52 i listan som tabellen skapas från.

Code: 
Sub Sortera_Pivottabell()

Application.ScreenUpdating = False
    Dim Singleweek_or_Accumulated As Integer
    Dim Week_number As Integer
    
    Singleweek_or_Accumulated = Range("J27")
'   if J27 is = 1  enskild vecka
'   if J27 is = 2 ackumulerad till och med veckonummer
    
    Week_number = Range("J29")
'   J29 = vald vecka
    
    If Singleweek_or_Accumulated = 1 Then

For X = 1 To 52
      With ActiveSheet.PivotTables("Pivottabell2").PivotFields("Datum")
        If X = Week_number Then
            .PivotItems("" & X).Visible = True
        Else
            .PivotItems("" & X).Visible = False
        End If
      End With
Next X

End If

If Singleweek_or_Accumulated = 2 Then

For X = 1 To 52
      With ActiveSheet.PivotTables("Pivottabell2").PivotFields("Datum")
        If X > Week_number Then
            .PivotItems("" & X).Visible = False
        Else
            .PivotItems("" & X).Visible = True
        End If
      End With
Next X

End If

End Sub
Jag har även ändrat raden
Code: 
If x <> Week_number Then
till
Code: 
If X > Week_number Then
Då jag har en 2:a i J27.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Limpieza y Error en Formularios
Replies
0
Views
498
jues
J
A
  • Solved
Error 70 en tiempo de ejecución formularios vba
Replies
3
Views
1K
Domenic
D
E
  • Question Question
Help Cleaning Up / Optimizing VBA Code
Replies
6
Views
527
offthelip
O
S
  • Solved
Web Query in VBA Loop through tables on page to choose get tags from table instead of text
2
Replies
13
Views
611
Domenic
D
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
1K
AndyEd
A

Forum statistics

Threads
1,223,959
Messages
6,175,644
Members
452,663
Latest member
MEMEH

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top