KOnvertering af celle format i VBA

Brug 'Søg og erstat'

Prøv denne:
Duer med/uden 1000 tals seperator og MAX 2 decimaler !!

Sub ChangeToDec()
'
' Change
' Macro recorded 14-09-2007 by JLEMMING
Dim value As String
Dim lng, t, i, ItIsNum

  If MsgBox("Alle tekster hvor kun tal og ""DKK "" indgår vil blive ændret til tal, format #.##0,00" _
    & vbCrLf & "Virker kun på tal med max. 2 decimaler" _
    & vbCrLf & "Er du sikker ?", vbYesNo + vbQuestion) = vbYes Then
    Application.ScreenUpdating = False
    ActiveSheet.Range("a1:aa500").Select
    For Each c In Selection
    ItIsNum = False
    value = c.value
    lng = Len(value)
      If Mid(value, 1, 4) = "DKK " Then                ' fjern evt. danske enheder
        value = Right(value, lng - 4)
        lng = Len(value)
      End If
      For i = 1 To lng                                  ' tal om det tal, m/u . ,
        If IsNumeric(Mid(value, i, 1)) Or Mid(value, i, 1) = "," Or Mid(value, i, 1) = "." Then
          ItIsNum = True
        Else
          ItIsNum = False
          Exit For
        End If
      Next i
      If ItIsNum = True Then
        For i = 1 To lng
          If Mid(value, i, 1) = "." Or Mid(value, i, 1) = "," Then
            If IsNumeric(Mid(value, i + 1, 1)) Then    ' tusindtal seperator ?
              If IsNumeric(Mid(value, i + 2, 1)) Then
                If IsNumeric(Mid(value, i + 3, 1)) Then
                  Mid(value, i, 1) = "."
                End If
              End If
            End If
            c.NumberFormat = "#,##0"
            If lng - i = 1 Then                ' 1 decimal ?
              Mid(value, i, 1) = ","
              c.NumberFormat = "#,##0.0"
            End If
            If lng - i = 2 Then                ' 2 decimaler ?
              Mid(value, i, 1) = ","
              c.NumberFormat = "#,##0.00"
            End If
          End If
        Next i
        c.value = value * 1                      ' omregn fra tekst til tal
      End If
    Next
  End If
End Sub

Prøv med:

Sub PtilK()
On Error Resume Next
    For Each c In ActiveSheet.UsedRange.Cells
        c.Value = CDbl(Replace(c.Value, ".", ","))
    Next c
End Sub

--->jkrons
Hvis jeg må have lov at forsvare min kode lidt, så er den lavet til en import, hvor nogen af tallene havde fejl i adskillelse af decimaler. Hvor der kun engang imellem stod . i stedet for ,

jlemming-> Der er ikke noget at forsvare :-) Min lsning var bare tænkt som et alternativ. erikjuuls løsning virker jo også fint.

Min egen kode ser sådanne ud
Sub Replace()
    Cells.Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True
    End Sub
Problemert er den virker, men ikke som macro. de tal der konverteres er gemt som tekst og ikke som tal, og problemet er at konvertere fra "." til "," så man ikke får fejlen med at det er "Numbers stored as tekst" den samme fejl kommer med jeres eksempler.

Jeg har forsøgt alt syntes jeg, og mange af læsningerne virker "manuelt" feks Search replace, men laves det om til en macro ændre den ikke formateringen på cellen den ændre...

HAr i en løsning på dette problem?

Det forstår jeg ikke, min kode virker fint på tekst her hos mig.

Står der bare 123.45 i tekstformat, og ikke andet ?, som f.eks ' foran

Kan du evt sende et eksemple ?

lemming,j(a)gmail,com

,=.

Min virker også fint hos mig. Så som jlemming siger tyder det på, at tallene ikke bare er tal, lagret som tekst på grund af punktummerne.

Jeg mailer den lige til dig i aften Jlemming, så kan du se om du kan se en grundt til det. For jeg har ikke "'" foran tallene. Måske er det en opsætnings fejl eller noget, men det er underligt at manuel ændring ordner det men macroer ikke har en effekt.

Mener du de tal fra række 241 sheet1?, dem kan jeg fint konvertere via min makro

måske er problemet enklere end det ser ud til.
Hvis ikke der allerede er det så omdøb filen til .csv og indlæs den med en variant af denne kode (ændring af filnavnet)
Når VBA læser en csv-fil ændrer den selv ,i DK-versionen, punktum til komma.

Sub Macro2()
    Workbooks.Open Filename:="C:\mintextfil.csv"
End Sub

Jeg har testet koden hjemme hos mig selv på 3 forskellige Pcer, og der er problemet det samme :S

HAr forsøgt at oprette nye dokumenter og importere daten ind i og Cut+pasted det ind i. Find&Replace virker kun når det køres mauelt, men VBA macro giver problemer hver gang. Det er meget mærkeligt syntes jeg.

Har du prøvet med min kode?,
hvad med mit spørgsmål 25/01-2008 08:32:38

Jeg har din løsning fandt den ved office

Bemærk!  Som standard vises systemseparatoren for tusinde. Du kan angive en anden systemseparator ved at ændre de internationale indstillinger i Kontrolpanel.

http://office.microsoft.com/da-dk/excel/HP012165161030.aspx

det er et svar ;)

Fandt du nogensinde ud af hvordan du ændre tal gemt som tekst, gennem makroen for jeg sidder og bakser med samme problem..?

Det opstår når jeg indsætter data med negativt fortegn altså -