Gå til innhold

problemer i excel

jozwiak

Anbefalte innlegg

jozwiak

jozwiak

Skrevet
Skrevet

hallo. jeg sliter for øyeblikket med noen regneark her. Ideen er å importere og summere en celle fra 52 forskjellige regnebøker i en celle i en annen regnebok.

 

har prøvd å få til noe lignene med access, men er ikke så stø på slikt. :whistle:

 

noen som har noen ideer?

 

på forhånd takk

Lenke til kommentar

Videoannonse

Videoannonse
Annonse
aadnk

aadnk

Skrevet
Skrevet

Åpne først Excel-dokumentet du vil at verdiene skal legges inn til. Legg inn en knapp via kontrollverktøykassen (View -> Toolbars -> Control Toolbox) ved å markere det tredje elementet fra toppen om en går slik man leser, og markere et område i regnearket.

 

Klikk så ALT+F11, velg Insert -> Module og lim inn følgende kode i tekstvinduet

som kommer opp:

Klikk for å se/fjerne innholdet nedenfor
Public Function SumFromBooks(Books As Collection, Sheet As String, Cell As String) As Double

   

    Dim Index As Long, Book As Workbook

 

    ' Gå gjennom alle de gitte bøker

    For Index = 1 To Books.Count

   

        ' Åpne denne boken

        Set Book = Workbooks.Open(Books(Index))

       

        ' Legg til verdien av denne cellen

        SumFromBooks = SumFromBooks + Val(Book.Sheets(Sheet).Range(Cell).Value)

       

        ' Lukk boken når vi er ferdig

        Book.Close

   

    Next

 

End Function

 

Public Function ValidPath(sFile As String) As String

 

    ' Add a slash if needed

    ValidPath = sFile & IIf(Right(sFile, 1) = "\", "", "\")

 

End Function

 

Public Function RetriveFileList(sPath As String, sFileExtension As String, bSubFolders As Boolean, Optional Attributes As VbFileAttribute = vbDirectory) As Collection

 

    Dim Folders As New Collection, Folder, File As String, vFile

    Dim sFileName As String, bAdd As Boolean

   

    ' Create a new file container

    Set RetriveFileList = New Collection

   

    ' Find all files and folders

    File = Dir(ValidPath(sPath), Attributes)

 

    ' Loop until we've found the last file/folder

    Do While File <> ""

   

        ' Firstly, see if this in fact IS a file or folder

        If File <> "." And File <> ".." Then

   

            ' Then find out whether or not this is a file

            If File Like "*.*" Then

           

                ' Further on, it needs to meat a certain pattern

                If File Like sFileExtension Then

               

                    ' Add the real file name

                    RetriveFileList.Add ValidPath(sPath) & File

                   

                End If

           

            Else ' If not, this must be a folder

           

                ' Add this folder to the list

                Folders.Add ValidPath(sPath) & File

           

            End If

   

        End If

       

        ' Find the next file/folder

        File = Dir

   

    Loop

   

    ' Look in subfolders if requested

    If bSubFolders Then

       

        ' Go through all folders found

        For Each Folder In Folders

       

            ' Search inside this folder as well

            For Each vFile In RetriveFileList(CStr(Folder), sFileExtension, True, Attributes)

           

                ' Add the file to our list

                RetriveFileList.Add vFile

           

            Next

       

        Next

   

    End If

 

End Function

Venstreklikk så på arket verdiene skal lastes inn i, og lim inn følgende kode i tekstvinduet:

Private Sub CommandButton1_Click()

 

    Range("A2") = SumFromBooks(RetriveFileList("D:\Udelt\", "*.xls", False, vbNormal), "Sheet1", "A1")

   

End Sub

A2 er cellen hvor teksten limes inn i, D:\Udelt\ er mappen Excel-filene hentes fra, False må settes til True dersom du ønsker å òg søke gjennom undermapper, Sheet1 er navnet på arket (du kan også bruke en indeks) cellen skal hentes fra, og A1 er navnet på cellen verdien hentes fra.

Lenke til kommentar
jozwiak

jozwiak

Skrevet
  • Forfatter
Skrevet

hallo igjen. takk for genialt svar! men jeg får det ikke til å fungere. :no:

 

jeg har gjort som du skriver, men det skjer ingenting når jeg trykker på knappen.

 

På sheet1 i vb limte jeg inn dettte:

 

Private Sub CommandButton1_Click()

 

Range("C20") = SumFromBooks(RetriveFileList("C:\Documents and Settings\Asus\Skrivebord\bedriftprosjekt\2007\", "*.xls", False, vbNormal), "Fyll inn her", "E19")

 

End Sub

 

 

 

og det andre du skrev ble limt inn i module1 i vb. men det skjer altså ingenting når jeg trykker på knappen. :blush:

Lenke til kommentar
aadnk

aadnk

Skrevet
Skrevet
og det andre du skrev ble limt inn i module1 i vb. men det skjer altså ingenting når jeg trykker på knappen.  :blush:

8758327[/snapback]

Hm, det kan hende du må endre Fyll inn her til indeksen til arket (1, 2 eller 3). Prøv å se om det endrer noe.

 

Ellers er det mulig Visual Basic-endringsmodus er påskrudd. Gå til View -> Toolbars -> Visual Basic og forsikre deg om at den nest siste knappen fra venstre er av (altså ikke nedtrykket).

Lenke til kommentar
aadnk

aadnk

Skrevet
Skrevet
noen tips?  :whistle:

8759269[/snapback]

Nå har jeg ikke Office 2007 installert, men utifra det jeg kunne finne ved å bruke testserveren til Microsoft, tror jeg du må velge Run -> Design Mode når du trykker ALT+F11 (ta det vekk, altså) for at koden skal kunne fungere. Men jeg kan ikke si noe om koden i det hele tatt vil fungere i Excel 2007.

Lenke til kommentar
jozwiak

jozwiak

Skrevet
  • Forfatter
Skrevet (endret)

Nå funker det! Avinstallerte 2007 og la inn 2003 igjen. :D

 

Men hva gjør jeg om jeg vil plukke ut flere celler fra de forskjellige arkene samtidig, uten at den må laste på alle arkene to ganger, og få listet disse opp i det nye arket? er det mulig?

 

takk for god hjelp! :thumbup:

Endret av jozwiak
Lenke til kommentar
aadnk

aadnk

Skrevet
Skrevet
Men hva gjør jeg om jeg vil plukke ut flere celler fra de forskjellige arkene samtidig, uten at den må laste på alle arkene to ganger, og få listet disse opp i det nye arket? er det mulig?

8762320[/snapback]

Hvor mange celler da? Det er litt vanskelig å tilpasse koden uten å vite spesifikt hva du skal gjøre.

Lenke til kommentar
aadnk

aadnk

Skrevet
Skrevet

Jo, men mener du at alle skal summeres til samme celle? Og er det snakk om akkurat de samme cellene for alle bøkene? Dersom du svarer ja på begge spørsmålene, må du endre den første funksjonen i modulen til følgende:

Public Function SumFromBooks(Books As Collection, ParamArray Locations() As Variant) As Double

 

    Dim Index As Long, Book As Workbook, Location, Parts

 

    ' Gå gjennom alle de gitte bøker

    For Index = 1 To Books.Count

 

        ' Åpne denne boken

        Set Book = Workbooks.Open(Books(Index))

     

        ' Legg til verdien av denne cellen

        For Each Location In Locations

            Parts = Split(Location, ".", 2)

            SumFromBooks = SumFromBooks + Val(Book.Sheets(Parts(0)).Range(Parts(1)).Value)

        Next

 

        ' Lukk boken når vi er ferdig

        Book.Close

 

    Next

 

End Function

Endre så koden i knappen til følgende:

Private Sub CommandButton1_Click()

 

    Range("A2") = SumFromBooks(RetriveFileList("D:\Udelt\", "*.xls", False, vbNormal), "Sheet1.A1", "Sheet1.A2", "Sheet2.A1", "Sheet3.B2")

 

End Sub

Som du ser, legger du bare til en ny paramenter med [Navn på ark].[Navn på celle] for å inkludere en celle i avlesingen.

Lenke til kommentar
aadnk

aadnk

Skrevet
Skrevet
hehe. det er samme cellene i alle filene, men de skal ikke summeres. de skal føres i hver sin celle.

8764537[/snapback]

Du får gjøre det manuelt da:

Dim Index As Long, Book As Workbook, Location, Parts

 

' Sett alle cellene til 0 her

Range("A1") = "0": Range("A2") = "0": Range("A3") = 0

 

' Gå gjennom alle de gitte bøker

For Index = 1 To RetriveFileList("D:\Udelt\", "*.xls", False, vbNormal)

 

    ' Åpne denne boken

    Set Book = Workbooks.Open(Books(Index))

 

    ' Legg til verdiene av cellene

    Range("A1") = Range("A1") + Book.Sheets("Sheet1").Cell("B1")

    Range("A2") = Range("A2") + Book.Sheets("Sheet1").Cell("B2")

    Range("A3") = Range("A3") + Book.Sheets("Sheet1").Cell("B3")

    ' Og flere ...

 

    ' Lukk boken når vi er ferdig

    Book.Close

 

Next

Lenke til kommentar
jozwiak

jozwiak

Skrevet
  • Forfatter
Skrevet

Får det ikke til å fungere. Men sånn ser det ut nå:

 

Private Sub CommandButton1_Click()

 

    Range("A2") = SumFromBooks(RetriveFileList("C:\Bedrift\2007\", "*.xls", False, vbNormal), "Ark1.C19", "Ark1.D19", "Ark1.E19", "Ark1.F19", "Ark1.G19", "Ark1.H19", "Ark1.D23", "Ark1.D24", "Ark1.D27", "Ark1.D28", "Ark1.D29", "Ark1.D33", "Ark1.D34", "Ark1.D35", "Ark1.D36", "Ark1.D37", "Ark1.D38", "Ark1.D39", "Ark1.D40", "Ark1.D41", "Ark1.D42", "Ark1.D43", "Ark1.D44", "Ark1.G9"

 

End Sub

 

Og sånn:

 

Public Function SumFromBooks(Books As Collection, ParamArray Locations() As Variant) As Double

 

  Dim Index As Long, Book As Workbook, Location, Parts

 

' Sett alle cellene til 0 her

Range("A1") = "0": Range("A2") = "0": Range("A3") = "0": Range("A4") = "0": Range("A5") = "0":

Range("A6") = "0": Range("A7") = "0": Range("A8") = "0": Range("A9") = "0": Range("A10") = "0":

Range("A11") = "0": Range("A12") = "0": Range("A13") = "0": Range("A14") = "0": Range("A15") = "0":

Range("A16") = "0": Range("A17") = "0": Range("A18") = "0": Range("A19") = "0": Range("A20") = "0":

Range("A21") = "0": Range("A22") = "0": Range("A23") = "0": Range("A24") = "0"

 

' Gå gjennom alle de gitte bøker

For Index = 1 To RetriveFileList("C:\Bedrift\2007\", "*.xls", False, vbNormal)

 

    ' Åpne denne boken

    Set Book = Workbooks.Open(Books(Index))

 

    ' Legg til verdiene av cellene

    Range("A1") = Range("A1") + Book.Sheets("Ark1").Cell("C19")

    Range("A2") = Range("A2") + Book.Sheets("Ark1").Cell("D19")

    Range("A3") = Range("A3") + Book.Sheets("Ark1").Cell("E19")

    Range("A4") = Range("A4") + Book.Sheets("Ark1").Cell("F19")

    Range("A5") = Range("A5") + Book.Sheets("Ark1").Cell("G19")

    Range("A6") = Range("A6") + Book.Sheets("Ark1").Cell("H19")

    Range("A7") = Range("A7") + Book.Sheets("Ark1").Cell("D23")

    Range("A8") = Range("A8") + Book.Sheets("Ark1").Cell("D24")

    Range("A9") = Range("A9") + Book.Sheets("Ark1").Cell("D27")

    Range("A10") = Range("A10") + Book.Sheets("Ark1").Cell("D28")

    Range("A11") = Range("A11") + Book.Sheets("Ark1").Cell("D29")

    Range("A12") = Range("A12") + Book.Sheets("Ark1").Cell("D33")

    Range("A13") = Range("A13") + Book.Sheets("Ark1").Cell("D34")

    Range("A14") = Range("A14") + Book.Sheets("Ark1").Cell("D35")

    Range("A15") = Range("A15") + Book.Sheets("Ark1").Cell("D36")

    Range("A16") = Range("A16") + Book.Sheets("Ark1").Cell("D37")

    Range("A17") = Range("A17") + Book.Sheets("Ark1").Cell("D38")

    Range("A18") = Range("A17") + Book.Sheets("Ark1").Cell("D39")

    Range("A19") = Range("A18") + Book.Sheets("Ark1").Cell("D40")

    Range("A20") = Range("A19") + Book.Sheets("Ark1").Cell("D41")

    Range("A21") = Range("A20") + Book.Sheets("Ark1").Cell("D42")

    Range("A22") = Range("A21") + Book.Sheets("Ark1").Cell("D43")

    Range("A23") = Range("A22") + Book.Sheets("Ark1").Cell("D44")

    Range("A24") = Range("A23") + Book.Sheets("Ark1").Cell("G9")

 

 

    ' Og flere ...

 

    ' Lukk boken når vi er ferdig

    Book.Close

 

Next

 

End Function

 

 

Hva har jeg gjort feil? :hmm:

Lenke til kommentar
aadnk

aadnk

Skrevet
Skrevet (endret)

Jeg mente du skulle plassere koden i Command1_Click:

Private Sub CommandButton1_Click()

 

    Dim Index As Long, Book As Workbook, Books

   

    ' Sett alle cellene til 0 her

    Range("A1") = "0": Range("A2") = "0": Range("A3") = "0": Range("A4") = "0": Range("A5") = "0":

    Range("A6") = "0": Range("A7") = "0": Range("A8") = "0": Range("A9") = "0": Range("A10") = "0":

    Range("A11") = "0": Range("A12") = "0": Range("A13") = "0": Range("A14") = "0": Range("A15") = "0":

    Range("A16") = "0": Range("A17") = "0": Range("A18") = "0": Range("A19") = "0": Range("A20") = "0":

    Range("A21") = "0": Range("A22") = "0": Range("A23") = "0": Range("A24") = "0"

   

    ' Hent liste over bøker

    Set Books = RetriveFileList("C:\Bedrift\2007\", "*.xls", False, vbNormal)

 

    ' Gå gjennom alle de gitte bøker

    For Index = 1 To Books.Count

   

        ' Åpne denne boken

        Set Book = Workbooks.Open(Books(Index))

   

        ' Legg til verdiene av cellene

        Range("A1") = Range("A1") + Book.Sheets("Ark1").Cell("C19")

        Range("A2") = Range("A2") + Book.Sheets("Ark1").Cell("D19")

        Range("A3") = Range("A3") + Book.Sheets("Ark1").Cell("E19")

        Range("A4") = Range("A4") + Book.Sheets("Ark1").Cell("F19")

        Range("A5") = Range("A5") + Book.Sheets("Ark1").Cell("G19")

        Range("A6") = Range("A6") + Book.Sheets("Ark1").Cell("H19")

        Range("A7") = Range("A7") + Book.Sheets("Ark1").Cell("D23")

        Range("A8") = Range("A8") + Book.Sheets("Ark1").Cell("D24")

        Range("A9") = Range("A9") + Book.Sheets("Ark1").Cell("D27")

        Range("A10") = Range("A10") + Book.Sheets("Ark1").Cell("D28")

        Range("A11") = Range("A11") + Book.Sheets("Ark1").Cell("D29")

        Range("A12") = Range("A12") + Book.Sheets("Ark1").Cell("D33")

        Range("A13") = Range("A13") + Book.Sheets("Ark1").Cell("D34")

        Range("A14") = Range("A14") + Book.Sheets("Ark1").Cell("D35")

        Range("A15") = Range("A15") + Book.Sheets("Ark1").Cell("D36")

        Range("A16") = Range("A16") + Book.Sheets("Ark1").Cell("D37")

        Range("A17") = Range("A17") + Book.Sheets("Ark1").Cell("D38")

        Range("A18") = Range("A17") + Book.Sheets("Ark1").Cell("D39")

        Range("A19") = Range("A18") + Book.Sheets("Ark1").Cell("D40")

        Range("A20") = Range("A19") + Book.Sheets("Ark1").Cell("D41")

        Range("A21") = Range("A20") + Book.Sheets("Ark1").Cell("D42")

        Range("A22") = Range("A21") + Book.Sheets("Ark1").Cell("D43")

        Range("A23") = Range("A22") + Book.Sheets("Ark1").Cell("D44")

        Range("A24") = Range("A23") + Book.Sheets("Ark1").Cell("G9")

   

   

        ' Og flere ...

   

        ' Lukk boken når vi er ferdig

        Book.Close

   

    Next

 

End Sub

Endret av aadnk
Lenke til kommentar
jozwiak

jozwiak

Skrevet
  • Forfatter
Skrevet (endret)

Feilmelding:

Compile Error:

Argument not optional

 

også markeres RetriveFileList i "For Index = 1 To RetriveFileList("C:\Bedrift\2007\", "*.xls", False, vbNormal)"

 

også blir "Private Sub CommandButton1_Click()" gul

Endret av jozwiak
Lenke til kommentar
jozwiak

jozwiak

Skrevet
  • Forfatter
Skrevet
Ah, beklager, det gikk nok litt for sjapt i svingene der. Jeg mener problemet er fikset nå. Prøv å legge inn koden min ovenfor på nytt.  :)

8766102[/snapback]

 

gjorde som du sa og det kom opp Runtime error 438: Object dosen't support property or method. Jeg trykker på debug og denne linjen blir gul:

Range("A1") = Range("A1") + Book.Sheets("Ark1").Cell("C19")

 

men det kom mange nuller på regnearket da :dribble:

Lenke til kommentar

Opprett en konto eller logg inn for å kommentere

Du må være et medlem for å kunne skrive en kommentar

Opprett konto

Det er enkelt å melde seg inn for å starte en ny konto!

Start en konto

Logg inn

Har du allerede en konto? Logg inn her.

Logg inn nå
Gå til emneliste
×
×
  • Opprett ny...