28. marts 2004 - 20:36Der er
12 kommentarer og 1 løsning
SUM.HVIS på synlige celler i et ark med autofilter
Spørgsmålet genfremsættes hermed - jeg var for hurtig til at belønne mig selv før. Dette er dog en let opdateret version. Pointtallet er også opdateret.
Jeg vil gerne lave en SUM.HVIS på de synlige celler i et ark med autofilter - altså ikke det kendte problem med at bruge SUBTOTAL for kun at summere de synlige, men derimod blandt de synlige celler kun at summere dem, som opfylder en given betingelse, uden at de celler, som er skjult med autofilter, og som opfylder samme betingelse, tælles med. Grunden til, at SUBTOTAL ikke kan bruges, er, at jeg skal bruge flere sumkriterier samtidig.
Jeg har indtil videre ikke fundet på en bedre løsning end at indsætte en kolonne, hvor hver celle får værdien 0, hvis rækken er skjult, og 1, hvis den er synlig. Herefter kan man så gange de værdier, der skal summeres, med værdien i den pågældende kolonne og så lave SUM.HVIS på resultatet. Det virker bare ikke. Jeg har gjort som i dette eksempel, hvor testværdierne 0/1 indsættes i kolonne B:
Range("A1").Select ActiveCell.SpecialCells(xlLastCell).Select tal = ActiveCell.Row For Each cell In Range("B1:B" & tal) If cell.Rows.Hidden = True Then cell.Value = 0 Else cell.Value = 1 End If Next
Variablen "tal" får rent faktisk den rigtige værdi, altså rækkenummeret på sidste række med data i kolonne A, også selv om rækken er skjult, men for de skjulte rækkers vedkommende virker tricket kun på dem, der kommer før sidste synlige række - de får værdien 0 i kolonne B, mens de skjulte rækker efter sidste synlige række beholder den værdi i kolonne B, som de havde i forvejen.
Så har jeg forsøgt at tilføje følgende:
Set dennecelle = ActiveCell.Offset(1, 0) Do Until dennecelle.Value = "" Set dennecelle.Offset(0, 1).Value = 0 Set næstecelle = dennecelle.Offset(1, 0) Set dennecelle = næstecelle Loop
- Men lige meget hjælper det. Hvorfor det, og hvad kan jeg gøre? Andre/bedre metoder til at løse problemet end ovenstående er også velkomne. Endelig: Rent bortset fra, at metoden her ikke fanger de nederste usynlige rækker, så virker den kun én gang. Hvis jeg ændrer kriterium i autofilteret og kører makroen en gang til, så kører den uendeligt langsomt – når jeg stopper den, kan jeg se, at den er et par sekunder om hver række, og den skal igennem ca. 3.000 rækker...
Public Sub SkjulteRækker() Dim RW As Variant For Each RW In Worksheets(1).Cells(1, 1).CurrentRegion.Rows If RW.Hidden = True Then RW.Cells(1, 2).Value = 0 Else RW.Cells(1, 2).Value = 1 End If Next
Public Sub SkjulteRækker() Dim RW As Variant For Each RW In ActiveSheet.Cells(1, 1).CurrentRegion.Rows If RW.Hidden = True Then RW.Cells(1, 2).Value = 0 Else RW.Cells(1, 2).Value = 1 End If Next End Sub
Weltklasse, kabbak, det virker, både i "celleversionen" og i "rækkeversionen" - men selvfølgelig mere oplagt at undgå omvejen over cellerne, når man ved hvordan... Stor tak! Før jeg fyrer pointene af: Performanceproblemet er der stadig - første gang går det fint (jeg tror du kører lidt hurtigere end min Athlon 2000, 512 MB ram), men anden gang er den stadig helt i knæ, 99 % cpu, og den er ikke færdig efter 5 minutter. Jeg forstår ikke, hvorfor opgaven skulle være så meget større - har du et bud??
Public Sub SkjulteRækker() Dim RW As Variant With Application .Calculation = xlManual .MaxChange = 0.001 End With ActiveWorkbook.PrecisionAsDisplayed = False For Each RW In ActiveSheet.Cells(1, 1).CurrentRegion.Rows If RW.Hidden = True Then RW.Cells(1, 2).Value = 0 Else RW.Cells(1, 2).Value = 1 End If Next With Application .Calculation = xlAutomatic .MaxChange = 0.001 End With ActiveWorkbook.PrecisionAsDisplayed = False Calculate End Sub
Det havde jeg allerede inde - strengt nødvendigt, for i virkeligheden sætter jeg nemlig ikke 0 og 1 ind i kolonne 2, men i kolonne 53, og seks af de mellemliggende kolonner (knap 3.000 rækker hver) afhænger af 0/1-kolonnen. Og på et andet ark i projektmappen er der 364 gennemsnitsberegninger (SUM.HVIS(...)/TÆL.HVIS(...)-formler), som afhænger af de seks kolonner. Men jeg synes bare ikke, at beregningen burde være mere kompleks anden gang end første gang??
Og jeg skal måske tilføje: Den går i stå, før autoberegningen bliver slået til igen - mens den laver For-Next. Når man pauser den med et minuts mellemrum, kan man se, at den har tygget sig igennem 50 rækker eller sådan noget - anden gang, altså. Første gang tager det hele 10-15 sekunder inkl. de mange beregninger. Oplever du slet ikke samme forskel??
test denne makro og se om den ikke kører hurtigere (det burde den)
Option Base 1
Sub TestOnFilters() Dim w As Worksheet Dim filterArray() Dim currentFiltRange As String 'Gem nuværende filtre Set w = ActiveSheet With w.AutoFilter currentFiltRange = .Range.Address With .Filters ReDim filterArray(1 To .Count, 1 To 3) For f = 1 To .Count With .Item(f) If .On Then filterArray(f, 1) = .Criteria1 If .Operator Then filterArray(f, 2) = .Operator filterArray(f, 3) = .Criteria2 End If End If End With Next End With End With
'Vis alle w.ShowAllData 'Find sidste række lastrow = Range("A65536").End(xlUp).Row 'Sæt 0 i alle celler i kolonne 53 (BA) Range("BA2:BA" & lastrow) = 0
'Sæt de gamle filtre på igen w.AutoFilterMode = False For col = 1 To UBound(filterArray(), 1) If Not IsEmpty(filterArray(col, 1)) Then If filterArray(col, 2) Then w.Range(currentFiltRange).AutoFilter Field:=col, _ Criteria1:=filterArray(col, 1), _ Operator:=filterArray(col, 2), _ Criteria2:=filterArray(col, 3) Else w.Range(currentFiltRange).AutoFilter Field:=col, _ Criteria1:=filterArray(col, 1) End If End If Next 'Skriv 1-tal i alle synlige celler i kolonne 53 (BA) Range("BA2:BA" & lastrow) = 1 End Sub
Undskyld reaktionstiden, havde en travl dag på jobbet. Og, ahøm, undskyld i det hele taget – jeg havde copy-pastet og ikke lige fået rettet ”xlAutomatic” til ”xlManual” (er her et musehul at krybe i?). I den situation bliver man ekstra rørt over den hjælpsomhed og kompetence, der lægges for dagen for at komme en karmaløs sjæl til undsætning. Tak bak for den formfuldendte løsning – man lærer altid noget af dine bidrag – men efter omstændighederne går pointene til kabbak, som kom først, og som løste det egentlige problem. Og kabbak, jeg håber de 100 også dækker en kvajebajer. I øvrigt bak – og lidt til min forundring: selv om du undgår nogle loops og test på enkeltrækker/-celler, så kører de to løsninger akkurat lige hurtigt, 45 sek. hver på jobbet og 17 sek. hver hjemme. Måske datamængderne skal være endu større, før forskellen ses – eller udfører excel det samme arbejde, uanset hvordan man spørger??
Tak for point, ja copy/paste har tit den ulempe at man ikke læser koden igennem, og så kommer fejlen. ;-))
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
