Hurtigt ændre alle værdi i et regneark fra DKK til Euro

hvis det alene er resultat-arket, du vil ændre, kan du jo lægge kursen i en celle (evt. skjult) og derefter gange dine resultater med denne.

Der er desværre ikke kun et resultatark, men mange. Jeg forstiller mig mere en funktion/kopi hvor man via fx indsæt-speciel-divider kan få kopieret alle ark og samtidig omregnet.

Denne lille makro er meget hurtig :-)

Public Sub DKKtoEURO()
    Dim rCell As Range
    For Each rCell In ActiveSheet.UsedRange.Cells
        If IsNumeric(rCell.Value) And Not (rCell.Value = 0) Then
            rCell.Value = rCell.Value * 7.77
        End If
    Next rCell
End Sub

er sku ikke sikker på, andet end den oz overskriver formler - rolig nu

Public Sub DKKtoEURO()
    Dim rCell As Range
    For Each rCell In ActiveSheet.UsedRange.Cells
        If IsNumeric(rCell.Value) And Not (rCell.Value = 0) And _
            Not (rCell.HasFormula) Then
            rCell.Value = rCell.Value * 7.77
        End If
    Next rCell
End Sub

Du kan selv lege med 7.77 og * eller / alt efter kursen og hvilken vej du vil regne

Ja - så skal jeg jo læse spørgsmålet - du skal jo igennem alle arkene

Public Sub DKKtoEURO()
    Dim rCell As Range
    Dim wks As Worksheet

    For Each wks In ActiveWorkbook.Worksheets
        For Each rCell In wks.UsedRange.Cells
            If IsNumeric(rCell.Value) And Not (rCell.Value = 0) And _
                Not (rCell.HasFormula) Then
                rCell.Value = rCell.Value * 7.77
            End If
        Next rCell
    Next wks
   
    Set rCell = Nothing
    Set wks = Nothing
End Sub

Koden skal vist udvides så den dækker alle ark ....
Ellers kunne man også lige så godt bruge indsæt-speciel-divider.

:-)

Tak for macro, men den virker desværre kun hvor det er værdier. Hvis det er resultater/formler/tekst giver det kørselsfejl 13

Ikke hos mig

IsNumeric - sikre at der kun køres på celle med værdier
NOT = 0 - sikre at der ikke divideres med nul (hvis du skulle den anden vej)
NOT .HasFormula - sikre at der ikke køres på celler med formler

Her vist på en let læselig måde

Public Sub DKKtoEURO()
    Dim rCell As Range
    Dim wks As Worksheet

    For Each wks In ActiveWorkbook.Worksheets
        For Each rCell In wks.UsedRange.Cells
            With rCell
                If IsNumeric(.Value) And _
                    Not (.Value = 0) And _
                    Not (.HasFormula) Then
                        .Value = .Value * 7.77
                End If
            End With
        Next rCell
    Next wks
   
    Set rCell = Nothing
    Set wks = Nothing
End Sub

Flemming: Den mangler at tage højde for tekst. Ellers tror jeg den virker!

Det burde IsNumeric tage højde for - tester lige igen.

Jeg får ingen fejl her. Når den fejler kan du trykke Debug.
Tryk så Alt+G og i det vindue der fremkommer skriver du
? rCell.Address    og trykker enter - så får du den celle den fejler i - hvad har du i den celle ?

Hvis jeg bare oprettet et nyt ark med et tal i A1 og en tekst i B2 får jeg fejlen. Hvis der ikke er nogle tekster får jeg ingen fejl.

Prøv at sende dette nye ark til mig fd@win-consult.com

Hvilken udgave af Excel bruger du - måske fejlen hænger der....

Det er 97 SR-2

OK - jeg genstarter lige maskinen i mit 97 spejl - øjeblik

Jeg skulle mene, at du kan få denne her til at virke

Public Sub DKKtoEURO()
    Dim rCell As Range
    Dim wks As Worksheet

    For Each wks In ActiveWorkbook.Worksheets
        For Each rCell In wks.UsedRange.Cells
            With rCell
                If IsNumeric(.Value) Then
                    If Not (.Value = 0) Then
                        If Not (.HasFormula) Then
                            .Value = .Value * 7.77
                        End If
                    End If
                End If
            End With
        Next rCell
    Next wks
   
    Set rCell = Nothing
    Set wks = Nothing
End Sub

Svar

Dagens mand! Rigtig god weekend

Ja med den titel kan det da kun blive en god week-end *GG* ilm