Autofilter i VB i excel 2007

Måske:

Sub optælAntalLinierDerVises()
Dim antal As Integer
    antal = 0
    antallinier = ActiveCell.SpecialCells(xlLastCell).Row
   
    For række = 1 To antallinier
REM TEST OM RÆKKEN VISES (EVT.VIA FILTER)
        If Rows(række).Hidden = False Then
            antal = antal + 1
        End If
    Next række
   
    MsgBox ("antal synlige linier: " + CStr(antal))
End Sub

Jo jo selvfølgelig men jeg må nok hellere udtrykke mig lidt mere klart :o)

Jeg vil gerne benytte autofilter for at slipper for at løbe flere tusinde linjer igennem af flere omgange.

Så vidt jeg har kunne måle mig til giver autofilteret mig et hurtigere resultat end hvis jeg laver flere indlejrede løkker.

Derfor giver det ingen mening først at sortere og dernæst alligevel løbe det hele igennem igen.

Kan man ikke på en og anden måde bare nøjes med at løbe alle ikke-hidden rækker igennem?

denne viser hvilke linier der er synlige
skal så istedet blot tilrettes dit formål

Sub test()
Range("A1:A" & Cells(65536, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Select
For Each c In Selection
MsgBox c.Address
Next
End Sub

Når du kopiere til et nyt ark, skal du i Excel 2007 gemme de filtrede rækker som et " Navngivet område"


Prøv at dig frem med nedestående VBA - Ret selv nedenstående
Range, Field, og Criteria til så det passer med dit regneark

læs her om VBA - Autofilter med flere kriterier.
http://www.ozgrid.com/VBA/autofilter-vba-criteria.htm



        'Filter rows with  autofilter
        With ActiveSheet
            .AutoFilterMode = False
            With .Range("A1:W171")
                .AutoFilter
                .AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(0, "31/12/2008")
                .AutoFilter Field:=12, Criteria1:="="

            End With
            Set rTable = .AutoFilter.Range
            lHeadersRows = rTable.ListHeaderRows
            'Resize the range minus lHeadersRows rows
            If lHeadersRows > 0 Then
                Set rTable = rTable.Offset(1).Resize(rTable.Rows.Count - lHeadersRows).SpecialCells(xlCellTypeVisible)
                rTable.Font.Color = vbBlack
            End If
           
            'move new range to  worksheet
            rTable.Copy Destination:= _
            Worksheets("Completed").Cells(Rows.Count, "B").End(xlUp)(2, 1)
            'rTable.EntireRow.Delete
            .AutoFilterMode = False
        End With
    End If
    Rows.AutoFit
End Sub

Glemte lige disse

Sub EksportToSheet

Dim rTable As Range
Dim lHeadersRows As Long

        'Filter rows with  autofilter
        With ActiveSheet
            .AutoFilterMode = False
            With .Range("A1:W171")
                .AutoFilter
                .AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(0, "31/12/2008")
                .AutoFilter Field:=12, Criteria1:="="

            End With
            Set rTable = .AutoFilter.Range
            lHeadersRows = rTable.ListHeaderRows
            'Resize the range minus lHeadersRows rows
            If lHeadersRows > 0 Then
                Set rTable = rTable.Offset(1).Resize(rTable.Rows.Count - lHeadersRows).SpecialCells(xlCellTypeVisible)
                rTable.Font.Color = vbBlack
            End If
           
            'move new range to  worksheet
            rTable.Copy Destination:= _
            Worksheets("Completed").Cells(Rows.Count, "B").End(xlUp)(2, 1)
            'rTable.EntireRow.Delete
            .AutoFilterMode = False
        End With
    End If
    Rows.AutoFit
End Sub

excelent --> I see why you got that name ;o)
Det virker jo spot on

pejsen --> Jeg har ikke forsøgt mig med din løsning da løsningen fra excelent gør at jeg slipper for at kopiere imellem de forskellige ark

got :-)

Det var så en sandhed med modifikationer at det virker "spot on"

Jeg får fint mit range men jeg kan ikke bruge det i alle funktioner som jeg gerne ville

Ved du hvorfor jeg ikke kan det?

Jeg kan godt denne her
Cells(x, 3) = WorksheetFunction.CountA(Worksheets("Spil").Range(arr(x) & "1:" & arr(x) & Sheets("Spil").Cells(65536, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible))
       

Men jeg kan ikke denne her
Cells(x, 4) = WorksheetFunction.CountIf(Worksheets("Spil").Range(arr(x) & "1:" & arr(x) & Sheets("Spil").Cells(65536, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible), sammenligning)

Den siger "kan ikke angive egenskaben CountIf for klassen WorksheetFunction

Jeg fanger det rigtige range så det undrer mig at den vil den ene men ikke den anden

Vis lige lidt mere af din kode, så jeg bedre kan gennemskue den
så kikker jeg på det lidt senere

Super :o)
Der er nu ikke så meget mere i det men sådan her ser det ud
Sammenligning er blot et tal

-----------------------------
sub sammenlign(sammenligning)
  arr = Array("", "B", "D", "F", "H", "J", "L", "N", "P", "R", "T", "V")
  For x = 1 To 11
    ' CountA virker fint
    Cells(x, 3) = WorksheetFunction.CountA(Worksheets("Spil").Range(arr(x) & "1:" & arr(x) & Sheets("Spil").Cells(65536, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible))
   
    ' CountIf virker fint hvis jeg hardcoder range sådan her
    ' Cells(x, 4) = WorksheetFunction.CountIf(Worksheets("Spil").Range("B86:B130"), sammenligning)
   
    ' CountIf virker ikke hvis jeg bruger præcis det samme som i CountA
    Cells(x, 4) = WorksheetFunction.CountIf(Worksheets("Spil").Range(arr(x) & "1:" & arr(x) & Sheets("Spil").Cells(65536, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible), sammenligning)
  Next
end sub

Det tyder på at countif ikke virker når området ikke er et sammenhængende område - jeg kan heller ikke få den til at funke

Men for mig at se handler det om at filtrere de linier fra (skjule) som ikke opfylder dine betingelser og så anvende denne

Cells(x,4)= Range("A1:A" & Cells(65536, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Count

Mystisk... nå men jeg kan jo godt se jeg kan vende det om som du foreslår... takker :o)