Makro > Punkt durch Komma ersetzen
#1
Hallo zusammen,

ich benutze momentan folgendes Makro (was auch super funktioniert):

Code:
Sub Werte_Übertragen()
  Dim Maßblatt As Object
  Dim Lastenheft As Object
  Dim sDatei As String
   
'Bildschirmaktualisierung ausschalten
     Application.ScreenUpdating = False
   
'Zieldatei festlegen
     Set Maßblatt = ActiveWorkbook
   
'Datei festlegen, öffnen und Daten übertragen
     ChDir ThisWorkbook.Path
     sDatei = Application.GetOpenFilename(, , "LH auswählen", , False)
     
'Wenn Öffnen abgebrochen wird
     If sDatei = "Falsch" Then Exit Sub
   
'Nur lesend öffnen
     Set Lastenheft = Workbooks.Open(sDatei, False, True)
   
'Übertragungen von einzelnen Zellen:
    Maßblatt.Sheets("Übergabe LH").Range("B1").Value = Lastenheft.Sheets("Lastenheft").Range("D15").Value
    Maßblatt.Sheets("Übergabe LH").Range("B2").Value = Lastenheft.Sheets("Lastenheft").Range("D17").Value
    Maßblatt.Sheets("Übergabe LH").Range("B3").Value = Lastenheft.Sheets("Lastenheft").Range("E189").Value
    Maßblatt.Sheets("Übergabe LH").Range("B4").Value = Lastenheft.Sheets("Lastenheft").Range("F189").Value
    Maßblatt.Sheets("Übergabe LH").Range("B5").Value = Lastenheft.Sheets("Lastenheft").Range("G189").Value
    Maßblatt.Sheets("Übergabe LH").Range("B6").Value = Lastenheft.Sheets("Lastenheft").Range("D201").Value
    Maßblatt.Sheets("Übergabe LH").Range("B7").Value = Lastenheft.Sheets("Lastenheft").Range("D203").Value
    Maßblatt.Sheets("Übergabe LH").Range("B8").Value = Lastenheft.Sheets("Lastenheft").Range("D205").Value
    Maßblatt.Sheets("Übergabe LH").Range("B9").Value = Lastenheft.Sheets("Lastenheft").Range("D236").Value
    Maßblatt.Sheets("Übergabe LH").Range("B10").Value = Lastenheft.Sheets("Lastenheft").Range("E238").Value
    Maßblatt.Sheets("Übergabe LH").Range("B11").Value = Lastenheft.Sheets("Lastenheft").Range("E240").Value
    Maßblatt.Sheets("Übergabe LH").Range("B12").Value = Lastenheft.Sheets("Lastenheft").Range("G22").Value
    Maßblatt.Sheets("Übergabe LH").Range("B13").Value = Lastenheft.Sheets("Lastenheft").Range("D159").Value
    Maßblatt.Sheets("Übergabe LH").Range("B14").Value = Lastenheft.Sheets("Lastenheft").Range("E164").Value
    Maßblatt.Sheets("Übergabe LH").Range("B15").Value = Lastenheft.Sheets("Lastenheft").Range("E196").Value
    Maßblatt.Sheets("Übergabe LH").Range("B16").Value = Lastenheft.Sheets("Lastenheft").Range("D252").Value
    Maßblatt.Sheets("Übergabe LH").Range("B18").Value = Lastenheft.Sheets("Lastenheft").Range("F247").Value
    Maßblatt.Sheets("Übergabe LH").Range("B19").Value = Lastenheft.Sheets("Lastenheft").Range("G247").Value
    Maßblatt.Sheets("Übergabe LH").Range("B21").Value = Lastenheft.Sheets("Lastenheft").Range("F246").Value
    Maßblatt.Sheets("Übergabe LH").Range("B22").Value = Lastenheft.Sheets("Lastenheft").Range("G246").Value

'nicht speichern
     Lastenheft.Close False
     
'Bildschirmaktualisierung einschalten
     Application.ScreenUpdating = True
     
'Variablen aufräumen
     Set Maßblatt = Nothing
     Set Lastenheft = Nothing
     
End Sub

In der Quelldatei kopiere ich eigentlich nur Zahlenwerte. Jetzt ist es aber so, dass manchmal die Zahlen mit einem Komma stehen und manchmal mit einem Punkt.
In der Zieldatei müssen aber alle Zahlenwerte immer mit einem Komma stehen.

Wie kann ich das Makro so anpassen, dass ein Punkt durch ein Komma ersetzt wird?

Vielen dank im Voraus
Top
#2
Hallo,

Code:
Sub Werte_Uebertragen()
  Dim Maßblatt As Object
  Dim Lastenheft As Object
  Dim sDatei As String
  
'Bildschirmaktualisierung ausschalten
     Application.ScreenUpdating = False
  
'Zieldatei festlegen
     Set Maßblatt = ActiveWorkbook.Sheets("Übergabe LH")
  
'Datei festlegen, öffnen und Daten übertragen
     ChDir ThisWorkbook.Path
     sDatei = Application.GetOpenFilename(, , "LH auswählen", , False)
    
'Wenn Öffnen abgebrochen wird
     If CVar(sDatei) = False Then Exit Sub
  
'Nur lesend öffnen
     Set Lastenheft = Workbooks.Open(sDatei, False, True).Sheets("Lastenheft")
  
'Übertragungen von einzelnen Zellen:
    Maßblatt.Range("B1").Value = Replace(Lastenheft.Range("D15").Value, ".", ",")
    Maßblatt.Range("B2").Value = Replace(Lastenheft.Range("D17").Value, ".", ",")
    Maßblatt.Range("B3").Value = Replace(Lastenheft.Range("E189").Value, ".", ",")
    Maßblatt.Range("B4").Value = Replace(Lastenheft.Range("F189").Value, ".", ",")
    Maßblatt.Range("B5").Value = Replace(Lastenheft.Range("G189").Value, ".", ",")
    Maßblatt.Range("B6").Value = Replace(Lastenheft.Range("D201").Value, ".", ",")
    Maßblatt.Range("B7").Value = Replace(Lastenheft.Range("D203").Value, ".", ",")
    Maßblatt.Range("B8").Value = Replace(Lastenheft.Range("D205").Value, ".", ",")
    Maßblatt.Range("B9").Value = Replace(Lastenheft.Range("D236").Value, ".", ",")
    Maßblatt.Range("B10").Value = Replace(Lastenheft.Range("E238").Value, ".", ",")
    Maßblatt.Range("B11").Value = Replace(Lastenheft.Range("E240").Value, ".", ",")
    Maßblatt.Range("B12").Value = Replace(Lastenheft.Range("G22").Value, ".", ",")
    Maßblatt.Range("B13").Value = Replace(Lastenheft.Range("D159").Value, ".", ",")
    Maßblatt.Range("B14").Value = Replace(Lastenheft.Range("E164").Value, ".", ",")
    Maßblatt.Range("B15").Value = Replace(Lastenheft.Range("E196").Value, ".", ",")
    Maßblatt.Range("B16").Value = Replace(Lastenheft.Range("D252").Value, ".", ",")
    Maßblatt.Range("B18").Value = Replace(Lastenheft.Range("F247").Value, ".", ",")
    Maßblatt.Range("B19").Value = Replace(Lastenheft.Range("G247").Value, ".", ",")
    Maßblatt.Range("B21").Value = Replace(Lastenheft.Range("F246").Value, ".", ",")
    Maßblatt.Range("B22").Value = Replace(Lastenheft.Range("G246").Value, ".", ",")

'nicht speichern
     Lastenheft.Parent.Close False
    
'Bildschirmaktualisierung einschalten
     Application.ScreenUpdating = True
    
'Variablen aufräumen
     Set Maßblatt = Nothing
     Set Lastenheft = Nothing
    
End Sub

Gruß Uwe
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • DeLaGhetto
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste