Overfør data fra "indtastningsformular" til andre ark.

En projektmappe består af 13 ark. Det første ark i mappen er et indtastningsark, hvor der altid indtastes i de samme fire celler, Navn i B1, Varigheden i B2, Måned i B3 og Beløb i B4.  

Derefter følger 12 ark, navngivet Januar, Februar, Marrts og så videre. Disse ark indeholder noget i denne forbindelse irrelevant information i rækkerne 1 til 8, bortset fra B2, som fortæller navnet på den person, som den seneste opdatering gælder. I A9 og B9 i alle disse ark står overskrifterne "Tid" og "Beløb". Dette er et krav for at koden skal virke efter hensigten.

Nu skal indtastningsarkets fire celler udfyldes. Når disse er udfyldt og makroen afspilles skal navnet, der er indtastes i B1 overføres til celle B2 i det ark, der svarer til den måned, der er specificeret i B3. Varigheden og beløbet skal overføres til de første ledige celler i henholdsvis A og B kolonnerne - efter overskrifterne i A9 og A10. Til sidst vendes tilbage til indtastningsarket og inputcellerne tømmes. Hvis ikke både navn og tgid er udfyldt vises en meddelelse. Hvis beløb ikke er udfyldt overføres værdien 0. Makroen er udstyret med nogen fejlhåndtering. Se kommentarer efter kode.

Denne makro løser opgaven. Den kan med fordel knyttes til en knap eller en genvejstastekombination.

Sub Overfoer()
'Erklær variable
    Dim Navn As String, Tid As Double, Beloeb As Single, Ark As String

'Tjek for fejl
    On Error GoTo Fejl:

'Tildel værdier til de variable
    Navn = Sheets(1).Range("B1")
    Tid = Sheets(1).Range("B2")
    Ark = Sheets(1).Range("B3")
    Beloeb = Sheets(1).Range("B4")

'Kontroller at både navn og tid er udfyldt.
    If Tid = 0 Or Navn = "" Then
        MsgBox "Både Navn, og tid skal være udfyldt, for at du kan overføre." & vbCrLf & _
            "Udfyld og prøv igen!", vbOKOnly + vbInformation
        Sheets(1).Range("A1").Activate
        Exit Sub
    End If

'Test om beløb er tom. Hvis Sand så sæt værdi til 0
    If IsEmpty(Beloeb) Then Beloeb = 0

'Overfør data til relevant placering i relevant ark
    Sheets(Ark).Activate
    ActiveSheet.Range("b2").Value = Navn
    Range("A1000000").End(xlUp).Offset(1, 0).Value = Tid
    Range("B1000000").End(xlUp).Offset(1, 0).Value = Beloeb

'Slet inputceller i Indtastningsark og gør klar til nyt input i A1
    Sheets(1).Activate
    Range("B1:B4").ClearContents
    Range("B1").Activate

'Fejlhåndtering
Fejl:
'Der findes ikke et ark med det navn, der står i A3
    If Err.Number = 9 Then
        MsgBox "Det ark, du vil sende data til eksisterer ikke." & vbCrLf & _
            "Kontroller måneden i A3, ret og prøv igen.", vbCritical
        Exit Sub
    End If

'Tid og/eller Beløb er ikke en numerisk værdi
    If Err.Number = 13 Then
        MsgBox "Både Varighed og beløb skal være tal." & vbCrLf & _
            "Ret og prøv igen.", vbCritical
        Exit Sub
    End If

End Sub

Jeg har valgt at kommentere koden, så det kan ses, hvad der sker hvor. I selve koden undersøges to ting, nemlig dels om begge felterne Navn og Tid er udfyldt. Hvis det ikke er tilfældet vises en fejlmeddelelse og koden afbrydes. Man skal derefter udfylde felterne og afspille makroen igen. Desuden undersøges om feltet med Beløb er udfyldt. Er det ikke tilfældet sættes værdien til 0.

I fejlhåndteringen undersøges først, om der findes et ark med det navn, der er angivet i cellen Måned. Er det ikke tilfældet, fx hvis der stavet forkert el.l. stoppes koden og der vises en fejlmeddelelse. Man kan så skrive navnet rigtigt eller indsætte arket, hvis det mangler. Dernæst testes om felterne Varighed og Beløb er udfyldt med numeriske værdier. Er det ikke tilfældet stoppes koden, og der vises en fejlmeddelelse. Man kan derefter rette og afspille igen.

- Tilbage til makroer -
- Tilbage til Excel -