Avatar billede ribo Nybegynder
28. maj 2011 - 23:41 Der er 2 kommentarer og
1 løsning

VBA: Finde sum i mange regneark

I en mappe har jeg regneark liggende, hvor der kan være alt fra 1 og op til 52 ark alle med filnavn fra "1" til "52" og endelsen xls. I samme mappe har jeg et excelark med filnavn "total" Nogen der har et bud på en VBA løsning, der kan kan lave summen af celle M20 i Ark1 af alle regneark med filnavn fra "1" til "52" og lægge det ind i celle C10 i regnearket "total"
Avatar billede supertekst Ekspert
29. maj 2011 - 14:57 #1
Mappe - ark - filnavn - terminologien skal nok tydeliggøres.

Hvis du konstruere en lille model, der er repræsentativ og sender den til min @-adresse (se under min profil) - så skal jeg prøve.
Avatar billede supertekst Ekspert
30. maj 2011 - 10:55 #2
Kode er indlagt under ark1 i filen Total.xls:

Const optælFraCelle = "M20"
Const indsætTotalCelle = "C10"

Dim xlsFil As Object
Dim aktuelleSti As String, total As Double
Public Sub optælling1Til52()
    aktuelleSti = ActiveWorkbook.Path
   
    total = 0
    traverserFilMappen aktuelleSti
    Range(indsætTotalCelle) = total
   
    MsgBox "Optælling afsluttet - total: " & CStr(total)

End Sub
Private Sub traverserFilMappen(mappeSti)
Dim fs, f, f1, fc, fNavn As String
Dim ræk As Long, kol As Long, linje As Variant

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(mappeSti)
    Set fc = f.Files
   
    For Each f1 In fc
        If okFilnavn(f1.Name) = True Then
           
            Set xlsFil = CreateObject("Excel.Application")
            With xlsFil
                .Workbooks.Open mappeSti & "\" & f1.Name
                .Sheets(1).Activate
                               
                total = total + .Range(optælFraCelle)
                .Quit
            End With
           
            Set xlsFil = Nothing
        End If
    Next
End Sub
Private Function okFilnavn(filnavn) As Boolean
Dim p As Byte, nr As Byte, fornavn As String
    p = InStr(filnavn, ".")
    If p > 0 Then
        fornavn = Left(filnavn, p - 1)
        okFilnavn = IsNumeric(fornavn)
    Else
        okFilnavn = False
    End If
End Function
Avatar billede ribo Nybegynder
30. maj 2011 - 12:58 #3
Det virker perfekt!!

Mange tak for hjælpen.
Avatar billede Ny bruger Nybegynder

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.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester