Excel/VBA: Hvordan laver man en makro om til en funktion?
Hej allesammen!
Jeg har lavet en makro i Excel/VBA, som jeg kan bruge til formatering af tal i Excel 2003, således at et tal udtrykkes med det antal decimaler, som svarer til et bestemt antal betydende cifre. F.eks. for 2 betydende cifre vil tallene 1234,56 og 0,56789 vises som hhv. 1200 og 0,57.
Så langt, så godt... Men dét, jeg er ude efter, er at lave en funktion, som kan gøre det samme. Hvis tallet f.eks. befinder sig i celle A1, vil jeg gerne i celle B1 kunne skrive "=FUNKTION(A1;SIGDIG)" Hvor SIGDIG er det antal betydende cifre jeg ønsker. Værdien af resultatet i B1 er den samme som i A1, men med det ønskede format.
Nedenunder er min makro kode. Hvis der er nogle, der kan vise, hvordan man kan lave en funktion ud af det, vil jeg være meget taknemlig.
Venlig hilsen, Matthew A. Rasmussen
'============================================================== Sub FormatSigDig()
Select Case decimals Case 0 Selection.NumberFormat = "0" Case 1 Selection.NumberFormat = "0.0" Case 2 Selection.NumberFormat = "0.00" Case 3 Selection.NumberFormat = "0.000" Case 4 Selection.NumberFormat = "0.0000" Case 5 Selection.NumberFormat = "0.00000" Case 6 Selection.NumberFormat = "0.000000" Case 7 Selection.NumberFormat = "0.0000000" Case Is > 7 Selection.NumberFormat = "0.0E+00" End Select
End Sub '==============================================================
I dette særtema om aspekter af AI ser vi på skiftet fra sprogmodeller til AI-agenter, og hvordan virksomheder kan navigere i spændet mellem teknologisk hastighed og behovet for menneskelig kontrol.
Select Case decimals Case 0 x = "0" Case 1 x = "0.0" Case 2 x = "0.00" Case 3 x = "0.000" Case 4 x = "0.0000" Case 5 x = "0.00000" Case 6 x = "0.000000" Case 7 x = "0.0000000" Case Is > 7 x = "0.0E+00" End Select
Desværre! Din funktion virkede fint - dog med den ærgelige virkning, at der sker en decideret *afrunding* af værdien. Hvis værdien 0.0094673 findes i celle A1 og jeg bruger din funktion i celle B1, dvs. B1 = SigDig(A1), så får jeg resultatet 0.0095, hvor værdien af B1 er 0.00950000, altså er der sket en afrunding og ikke kun en formatering, som min makro oprindeligt sørgede for. Desuden får jeg med din funktion SigDig(0.010) = 0.01 dvs. Excel har smidt det sidste nul væk...
Jeg tror det smartest vil være at køre videre med min makro, hvor jeg sørger for en eller anden slags auto-update hver gang værdien ændres, jf. min sidste kommentar... Hvis du har forstand på sådan noget må du gerne give et praj om, hvordan det kan skrues sammen.
Select Case decimals Case 0 Range(selle).NumberFormat = "0" Case 1 Range(selle).NumberFormat = "0.0" Case 2 Range(selle).NumberFormat = "0.00" Case 3 Range(selle).NumberFormat = "0.000" Case 4 Range(selle).NumberFormat = "0.0000" Case 5 Range(selle).NumberFormat = "0.00000" Case 6 Range(selle).NumberFormat = "0.000000" Case 7 Range(selle).NumberFormat = "0.0000000" Case Is > 7 Range(selle).NumberFormat = "0.0E+00" End Select
End Sub
Om det virker efter hensigten, ved jeg ikke, men når du fysisk ændrer en værdi i A kolonnen vil koden køre.
Vi tager kabbak's fortrinlige løsning med at bruge worksheet change:
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then ' A kolonnen frmt2 Target.Address, Target.value, ActiveSheet.Range("A1") End If End Sub
Her er så mit bud på funktionen der klarer din opgave:
Function frmt2(adr, tal, bet) If Len(tal) <= bet Then frmt2 = tal: GoTo slutprut If tal < 10 Then a = InStr(1, tal, ",", vbBinaryCompare) If a > 0 Then If tal < 1 Then bet = bet + 2 If tal >= 1 Then bet = bet + 1 antdec = Len(tal) - a tilladdec = Len(tal) - bet - 1 If tilladdec > 0 Then ef = "0." For i = 1 To tilladdec ef = ef & "0" Next i End If frmt2 = CDbl(Format(tal, ef)) End If If a = 0 Then frmt2 = CStr(Left(tal, bet)) For i = (bet + 1) To Len(tal) frmt2 = frmt2 & "0" 'frmt2 = frmt2) Next i End If slutprut: ActiveSheet.Range(adr) = frmt2 End Function
Ja, undskyld jeg trænger mig på igen, men den her morer mig lidt. Der var lige lidt småfejl i den tidligere udgave og så har jeg samlet det hele i en kode.
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 And Target.Row > 1 And Target.value <> "" Then ' A kolonnen adr = Target.Address tal = Target.value bet = ActiveSheet.Range("A1") If Len(tal) <= bet Then frmt2 = tal: GoTo slutprut If tal < 10 Then a = InStr(1, tal, ",", vbBinaryCompare) If a > 0 Then If tal < 1 Then bet = bet + 2 '0 og komma If tal >= 1 Then bet = bet + 1 'komma antdec = Len(tal) - a tilladdec = Len(tal) - antdec If tilladdec > 0 Then ef = "0." For i = 1 To tilladdec ef = ef & "0" Next i End If frmt2 = CDbl(Format(tal, ef)) End If If a = 0 Then ef = "0" frmt2 = CStr(Left(tal, bet)) For i = (bet + 1) To Len(tal) frmt2 = frmt2 & "0" Next i End If slutprut: Target.NumberFormat = ef Target.value = frmt2 End If End Sub
Den afrunder stadig ikke 1256 til 1300 men jeg er ikek sikker på at dette er meningen? Det er blot fordi at 0,56 skal afrundes til 0,57...
Der var også fejl i ovenstående, hvis man varierer antallet af decimaler. Nu afrunder den og skriver værdien i en ny kolonne, for jeg kan ikke forestille mig at man skal bruge andre data end dem man indtaster. Det vil gøre det lidt svært at fejlsøge...
Nu kan jeg ikke finde flere fejl, men den er blevet lidt kringlet at overskue...
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 And Target.Row > 1 Then ' A kolonnen On Error GoTo slutprut ef = Target.NumberFormat adr = Target.Address tal = Target.value bet = ActiveSheet.Range("A1") a = InStr(1, tal, ",", vbBinaryCompare) If a > 0 And tal >= 1 Then bet = bet + 1 ' komma If a > 0 And tal < 1 Then bet = bet + 2 ' 0 & komma If Len(tal) <= bet Then frmt2 = tal: GoTo slutprut If tal >= 10 Then tal = Round(tal, 0): a = 0 If a > 0 Then antdec = Len(tal) - a Do antdec = antdec - 1 Loop While antdec + a > bet frmt2 = Round(tal, antdec) If antdec > 0 Then ef = "0." For i = 1 To antdec ef = ef & "0" Next i End If End If If a = 0 Then ef = "0" frmt2 = (Round(tal / (10 ^ (Len(tal) - bet)), 0)) * (10 ^ (Len(tal) - bet)) End If slutprut: ActiveSheet.Cells(Target.Row, Target.Column + 1).NumberFormat = ef ActiveSheet.Cells(Target.Row, Target.Column + 1) = frmt2 End If End Sub
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.
