Automatisk indskrivning af tal i

Automatisk indskrivning af tal i skema

Udfordring:

I et regneark (se nedenfor), findes i kolonne A (fra række 6 til ca. 200 nogle varenumre. Kolonne B indeholder en summering af tallene i samme række. I række 2 står ugenumre angivet som tekst, fx "Uge 3". I række 5 summeres tallene i de enkelte kolonner.


		Uge 01	Uge 02	Uge 03	Uge 04	Uge 05	Uge 06	Uge 07	Uge 08	Uge 09
Vare.nr.
	Sum
	976	211	204	0	40	58	442	0	21	0
19	100	5	19		19	4	39		14
12	69	15	19		3	4	28
78	176	10	35		17	1	112		1
102	212	67	31			10	102		2
444	125	26	36			6	53		4
123	183	32	31			23	97
123	111	56	33		1	10	11

I B3 (ved siden af Vare.nr.) indtastes et varenummer og i C3 et antal. Dette antal skal nu overføres til den korrekt uge, beregnet på grundlag af datoen for indtastningen) i rækken ud for det relevante varenmummer. Indtastes fx den 2. marts varenummer 444 i B3 og 17 i C3, skal der skrives 17 i K10, da datoen fin des i uge 9. Ugenummeret beregnes på baggrund af pc'ens indstillede dato.

Denne løsning er baseret på hændelsen Worksheet_Change og afspilles derfor automatisk, når denne hændelse indtræffer i den relevante celle, men den kunne også have været skrevet som en "almindelig" makro og afspillet manuelt.

Koden virker på den måde, at når man taster et antal i C3 (udløsercellen). vil den se på B3, om denne celle er udfyldt. Hvis det ikke er tilfældet, får man en meddelelse om, at både varenummer og antal skal være udfyldt. Står der et populationsnummer, vil den se om dette findes i A-kolonnen. Gør det ikke det, får man en meddelelse om dette, og både B3 og C3 tømmes. Såfremt begge celler er udfyldt, og populationsnummeret findes, vil den skrive antallet i den aktuelle uge ud for det pågældende populationsnummer.

NB! Husk at ændringer i et arket, der foretages via makro, ikke kan fortrydes med fortryknappen, så hvis man taster forkert varenummer eller antal, må arket rettes manuelt.

I eksemplet nedenfor er koden kommenteret, så man kan se, hvad de enkelte dele gør.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errhan

'Først skal vi lige erklære nogle variable.

Dim r As Integer, co As Integer, unr As Byte, runr As String

'Så går vi i gang og undersøger først et par ting om indtastningen.
' Er der tastet i den celle, der udløser funktionen (C3), ellers ignorer.

If Not Intersect(Target, Range("c3")) Is Nothing Then

' Er cellen tom, er det nok fordi indholdet er blevet slettet. Så skal der ikke ske noget.

If IsEmpty(Target) Then
Exit Sub

End If

'Står der et varenummer i B3? Det skal der, ellers gives en advarsel og funktionen stoppes.

        If IsEmpty(Range("b3")) Then
            MsgBox "Både antal styk og population skal være udfyldt", vbOKOnly + vbCritical
            Exit Sub
        End If

'Hvis alt er i orden forsættes koden.
'Først findes det korrekte ugenummer på baggrund af pc'ens værdi for dags dato.
'Ugenumrene i række 2 skal være indtastet som fx Uge 01. Der må ikke være dobbeltmellemrum mellem tekst og tal.

unr = Int((Int((Date + 2924) / 7) * 28 Mod 1461) / 28 + 1)

'Det fundne ugenummer sammenkædes med teksten Uge. Det undersøges om dcer skal indsættes et 0 før ugenummeret.
'Dette sker, hvis det fundne ugenummer kun har et ciffer. Ellers bruges det fundne ugenummer direkte.

If Len(unr) = 1 Then

runr = "uge 0" & unr

        Else
            runr = "uge " & unr
        End If

'Så findes det rækkenummer, hvor det indtastede varenummer står.

For Each c In Range("a6:a300").Cells
If c.Value = Range("b3").Value Then

                r = c.Row
            End If
        Next c

'Så findes kolonnenummeret for den relevant uge.

For Each d In Range("c2:z2").Cells
If d.Value = runr Then

                co = d.Column
            End If
        Next d

'Så skrives det indtastede stykantal i den relevante celle og
'Indholdet i indtastningscellerne slettes.

Cells(r, co).Value = Range("c3").Value
Range("c3").ClearContents

        Range("b3").ClearContents

    End If

    Exit Sub

'Fejlhåndtering

errhan:

If Err.Number = 1004 Then
MsgBox "Du har indtastet et populationsnummer, der ikke findes i A-kolonnen" & vbCrLf & "Ret nummeret og prøv igen", vbOKOnly + vbInformation

        Range("c3").ClearContents
        Range("b3").ClearContents
        Exit Sub
    End If

End Sub