Avatar billede klausholm Nybegynder
14. juli 2009 - 15:35 Der er 2 kommentarer og
1 løsning

Liste til tabel

Hej eksperter,

Fra en kontoudskrift vil jeg gerne have lagt de enkelte poster ind i mit årsbudget.
Kontoudskriftet dækker typisk en periode som er mindre end årsbudgettet. Derfor skal kun posterer med ændringer opdateres på årsbudgettet.

Jeg forestiller mig det skal se således ud:

"Kontoudskrift": (Tabellen som "Årsbudget" skal hente værdier i)
Mdr.    Tekst            Beløb
1    Udgift_1    100
1    Udgift_2    200
1    Udgift_3    300
1    Udgift_4    700
2    Udgift_1    400
2    Udgift_3    600
2    Udgift_4    400
12    Udgift_2    100
12    Udgift_3    200
12    Udgift_4    300


Kontoudskrift udskiftes løbende og der refereres kun til samme tabelnavn"kontoduskrift"
 
Årsbudget:
Tekst      Mdr_1      Mdr_2        Mdr_3      Mdr_4…………………Mdr_12
Udgift_1  100      400        gl.beløb_3      gl.beløb_7  gl.beløb_11
Udgift_2  200      gl.beløb_2 gl.beløb_4      gl.beløb_8  100
Udgift_3  300    600        gl.beløb_5    gl.beløb_9  200
Udgift_4  700    400        gl.beløb_6    gl.beløb_10 300

Det er vigtigt, at der kun indsættes værdier i "Årsbudget", hvis der er opdateringer, ellers skal den gamle værdi (gl.beløb_x) blive stående. Opdateringer ønskes med rød skrift
Avatar billede supertekst Ekspert
14. juli 2009 - 18:01 #1
Rem Koden anbringes under arket Kontoudskrift
Rem =========================================
Const kontoUdskriftArkNavn = "kontoudskrift"
Dim ktoArk As Worksheet
Dim månedNr As Byte, ktoTekst As String, beløb As Long

Const årsbudgetArkNavn = "årsbudget"
Dim budgetArk As Worksheet
Dim budgetRække
Sub opdaterBudget()                                'Kan forbindes med knap ellerkaldes fra Alt+f8
Dim ræk As Integer, sidsteRække As Integer
    Set ktoArk = ActiveWorkbook.Sheets(kontoUdskriftArkNavn)
    Set budgetArk = ActiveWorkbook.Sheets(årsbudgetArkNavn)
   
Rem traverser kontoudskrift
    sidsteRække = ActiveCell.SpecialCells(xlLastCell).Row
   
    For ræk = 2 To sidsteRække
        månedNr = Cells(ræk, 1)
        ktoTekst = Cells(ræk, 2)
        beløb = Cells(ræk, 3)
       
        budgetRække = findBudgetRække(ktoTekst)
        If budgetRække > 0 Then
            With budgetArk.Cells(budgetRække, månedNr + 1)
                .Value = beløb
                .Font.ColorIndex = 3
            End With
        Else
            MsgBox ("Kontotekst: " & ktoTekst & " kunne ikke findes i årsbudget!")
        End If
    Next
   
    MsgBox ("Opdatering afsluttet")
End Sub
Private Function findBudgetRække(kontotekst)
    With budgetArk.Range("A:A")
        Set c = .Find(kontotekst, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            findBudgetRække = c.Row
        Else
            findBudgetRække = 0
        End If
    End With
End Function
Avatar billede klausholm Nybegynder
15. juli 2009 - 23:07 #2
Sådan!!!Supertekst
Det virker perfekt.....endda med et par ekstra features...smukt
Avatar billede supertekst Ekspert
15. juli 2009 - 23:12 #3
Fint & tak - du får så "regningen"
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
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

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