Avatar billede sito Nybegynder
27. marts 2007 - 10:24 Der er 8 kommentarer og
1 løsning

Hent af nyeste række i underliggende ark

Hej

Jeg er i gang med at forsøge at lave en ren excel løsning til et problem. Jeg har et hovedark, med en række underliggende ark, som bliver linket ind i hovedarket.

Nu ville jeg gerne lave det sådan, at det kun er den nyeste række der er tilføjet i det underliggende ark der bliver hentet ind i hovedarket. Er det noget der kan lade sig gøre? Det skal lige siges, at alle felterne i de to ark er ens.

Håber i kan hjælpe.
Avatar billede supertekst Ekspert
27. marts 2007 - 10:52 #1
Via VBA kan det lade sig gøre at overføre den sidste række fra hvert underark til hovedarket - uden brug af formler/sammenkædning.

Er det dette du vil?
Avatar billede sito Nybegynder
27. marts 2007 - 10:56 #2
Ja, det lyder helt rigtigt!
Avatar billede supertekst Ekspert
27. marts 2007 - 11:03 #3
D.v.s. at hovedarket bliver overskrevet med "de sidste rækker"!
Hvad hedder "hovedarket"?
Avatar billede supertekst Ekspert
27. marts 2007 - 11:21 #4
Forslag - koden kopieres til VBA/ThisWorkbook (Alt+F11):
Koden udføres, når filen åbnes.


Const hovedArkNavn = "hovedark"            'Tilpasses
Private Sub workbook_activate()
Dim hræk
    hræk = 1
   
    For Each ark In ActiveWorkbook.Sheets
        If LCase(ark.Name) <> hovedArkNavn Then
            ark.Activate
            antalræk = ActiveCell.SpecialCells(xlLastCell).Row
            antalKol = ActiveCell.SpecialCells(xlLastCell).Column
           
            For k = 1 To antalKol
                værdi = Cells(antalræk, k)
                ActiveWorkbook.Sheets(hovedArkNavn).Cells(hræk, k) = værdi
            Next k
            hræk = hræk + 1
        Else
            ark.Cells.Clear
        End If
    Next ark
   
    ActiveWorkbook.Sheets(hovedArkNavn).Activate
End Sub
Avatar billede sito Nybegynder
27. marts 2007 - 11:31 #5
Den giver et problem med denne linie:

ActiveWorkbook.Sheets(hovedArkNavn).Cells(hræk, k) = værdi

Det er i hovedarket jeg skal indsætte koden i ThisWorkbook, ikke?
Avatar billede sito Nybegynder
27. marts 2007 - 11:36 #6
Den siger 'Subscript out of range'
Avatar billede supertekst Ekspert
27. marts 2007 - 11:42 #7
Hovedarkets navn - i min kode er det anført som: "hovedark" - evt. korriger dette i koden: Const hovedArkNavn = "hovedark"            'Tilpasses

Koden indlægges i ThisWorkBook - den nederste i VBA-strukturen - ses v/Alt+F11

--

Ellers send en mail til: pb@supertekst-it.dk - så sender jeg min test-model
Avatar billede sito Nybegynder
27. marts 2007 - 12:44 #8
Der er sendt en mail. Har smidt navnet på mit ark ind i "hovedark", og problemet er der stadig.
Avatar billede supertekst Ekspert
28. marts 2007 - 11:40 #9
Const hovedArkFil = "hovedark.xls"                                                      'Tilpasses
Const kildeFilSti = "C:\Documents and Settings\pb\Skrivebord\2703FlytFraTil\"          'Fælles-Mappen Tilpasses
Dim kXLS As Object, hræk
Private Sub workbook_activate()
    hræk = 1

Rem sletter indhold i hovedarkFilen (Ark 1)
    ActiveWorkbook.Sheets(1).Cells.Clear
   
Rem gennemsøg "fælles-mappen"
    søgiMappen
   
Rem vis hovedarket
    ActiveWorkbook.Sheets(1).Activate
   
    MsgBox ("Overførsel er afsluttet")
End Sub
Private Sub søgiMappen()                            'Der søges efter filer i Kildefil-stien
Dim fs, f, f1, fc, s
   
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(kildeFilSti)
    Set fc = f.Files
    For Each f1 In fc
        If LCase(f1.Name) <> hovedArkFil Then      'HovedArk-filen medtages ikke
            gennemgåKildeFil f1.Name
        End If
    Next
End Sub
Private Sub gennemgåKildeFil(kfil)                  'data hentes fra ark1 i kildefil
Dim count
    On Error GoTo fejl                              'hvis fejl - lukkes object-filen
   
Rem Åbner kildefilen
    Set xls = CreateObject("Excel.application")
    With xls
        .Workbooks.Open kildeFilSti + kfil
   
        .Sheets(1).Activate
        antalræk = .ActiveCell.SpecialCells(xlLastCell).Row
        antalKol = .ActiveCell.SpecialCells(xlLastCell).Column
       
        count = 0
        For k = 1 To antalKol
            værdi = .Cells(antalræk, k)
            If værdi <> "" Then
                ActiveWorkbook.Sheets(1).Cells(hræk, k) = værdi
                count = count + 1
            End If
        Next k
        If count > 0 Then
            hræk = hræk + 1                    'optæl kun række hvis indhold overført(forhindre tomme celler)
        End If
    End With

fejl:
    xls.Quit
    Set xls = Nothing
End Sub
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



IT-JOB