Office: CSV und Sonderzeichen

Burt Macklin · 19. Januar 2020

Hallo!

Ich exportiere Daten von einer Software in eine csv-Datei, diese kopiere ich per Makro in ein Tabellenblatt. Funktioniert soweit super, allerdings ist mir jetzt aufgefallen, dass es bei Sonderzeichen hakt.

Code:

With Workbooks.Open("c:resu.csv", Local:=True)
.Worksheets(1).UsedRange.copy Destination:=ThisWorkbook.Worksheets("Res").Cells(1)
.Close SaveChanges:=False
End With
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Aus "Ø" wird z.B. "Ã˜".

Ich kann die Codierung die das Programm beim Export liefert nicht beeinflussen. Wenn ich die csv-Datei mit dem Notepad öffne und speichere, dann klappt es einwandfrei. Aber das wäre keine vernünftige Lösung.

Kann man das im Makro in den Griff kriegen?

Gruß Tobias

:)

Flotter Feger · 21. Januar 2020

Hallo,

nimm nicht Workbook.Open, sondern Workbook.OpenText.
Da gibt es den Parameter Origin ... Unicode(UTF-8) stellt man so ein ... Origin:=65001

With Workbooks.OpenText("c:\resu.csv", Origin:=65001, Local:=True)

Besser so ?

Sabina

Burt Macklin · 21. Januar 2020

Hallo Sabina,

das hört sich gut an, ich probiere es aus. Dankeschön!

Ich habe es vorerst mit Ersetzen der einzelnen Sonderzeichen gelöst, was natürlich nicht so elegant ist.

Gruß Tobias

EDIT: opentext funktioniert nicht. *grübel* "Function oder Variable erwartet." *doppelgrübel*

Flotter Feger · 22. Januar 2020

Hallo,

... tolle Sache ... was hast du probiert ... wie hast du es probiert ... und warum zeigst du den Code nicht ...

Musst du nicht ... zeichne dir das Öffnen einfach mal auf ... Datei -> Öffnen -> auf 'prn, txt, csv' umstellen.

Sabina

Burt Macklin · 23. Januar 2020

Hallo!

Sorry, hier der Code der nicht funktioniert hat:

Code:

Sub t20200222_txt_einfg()
With Workbooks.OpenText("c:tempresu.csv", Origin:=65001, Local:=True)
.Worksheets(1).UsedRange.copy Destination:=ThisWorkbook.Worksheets("Res").Cells(1)
.Close SaveChanges:=False

End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich weiß nicht genau wie du das meinst mit dem Aufzeichnen. Da nimmt er mir nur auf

Code:

Sub Makro1()
'
' Makro1 Makro
'

'
ChDir "C:temp"
Workbooks.Open Filename:="C:tempResu.csv"

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß Tobias

Flotter Feger · 23. Januar 2020

Hallo,

lade mal eine Muster-CSV hoch, in der die Zeilen drin stehen, die Ärger machen ... hänge dazu einfach hinten die Endung ZIP an.

Für alles andere, müsste ich meinen Zauberhut aus der Schachtel holen ... der will da nur nicht wieder rein und fliegt dann ständig mit dem Besen um die Wette durch die Gegend ... sind echt nervig die zwei.

Sabina

Mase · 9. Februar 2021

von Flotter Feger

Hallo,

lade mal eine Muster-CSV hoch, in der die Zeilen drin stehen, die Ärger machen ... hänge dazu einfach hinten die Endung ZIP an.

Für alles andere, müsste ich meinen Zauberhut aus der Schachtel holen ... der will da nur nicht wieder rein und fliegt dann ständig mit dem Besen um die Wette durch die Gegend ... sind echt nervig die zwei.

Sabina
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

*grins

Burt Macklin · 27. Januar 2020

Hallo!

Sorry, dass es so lange gedauert hat. Ich habe jetzt eine unangetastete Datei erzeugt, ohne Firmennamen usw.

Danke für Deine Geduld und Gruß an Hut und Besen *biggrin.gif*

https://www.ms-office-forum.net/foru...1&d=1580202767

Hier mal noch der ganze aktuelle Code um weitere Verwirrung zu vermeiden. *tongue.gif*
Wobei der Teil unter dem Kommentar "Prüfung Übereinstimmung" neu ist. Der ist nur seperat getestet. Ich habe es noch nicht geschafft die zwei Prüfungen mit if not ... and not... zu Verknüpfen :-( --> siehe Edit unten

Code:

Sub prod_test()

Application.ScreenUpdating = False

'Benutzerkürzel abfragen

Dim sTxt As String, sPrompt As String, sDefault As String
sPrompt = "Benutzerkürzel eingeben:"
sDefault = "th"
sTxt = InputBox(prompt:=sPrompt, Default:=sDefault)

Sheets("Res").Cells.Clear

If Dir("c:tempdemo.csv") = "" Then
MsgBox "Bitte die Analysenwerte im Results-Manager" & vbCrLf & "als Textdatei exportieren.", vbCritical, "Exportdatei nicht gefunden"
Exit Sub '--Makro beenden
Else

With Workbooks.Open("c:tempdemo.csv", Local:=True)
.Worksheets(1).UsedRange.copy Destination:=ThisWorkbook.Worksheets("Res").Cells(1) ' Ziel-Blatt (Test) anpassen *****
.Close SaveChanges:=False
End With

'Sonderzeichen ersetzen
Cells.Replace What:="Ã¼", Replacement:="ü", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

Cells.Replace What:="Ã", Replacement:="Ø", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

End If

' Datei löschen

' Dim Datei As String
' Datei = "C:tempResu.csv"
' Kill Datei

'
'
Dim AnZ As Long
Dim wksQ As Worksheet, wksZ As Worksheet, wksY As Worksheet, wksX As Worksheet
Set wksQ = Worksheets("res") '--Quellblatt
Set wksZ = Worksheets("1 normiert getr. Probe") '--Zielblatt
Set wksY = Worksheets("2 normiert gegl. Probe") '--Zielblatt 2
Set wksX = Worksheets("3 Rohdaten getr. Probe") '--Zielblatt 3
AnZ = wksQ.Range("F100").End(xlUp).Row

'MsgBox (AnZ)

If AnZ Mod 3 > 0 Then '--Pruefung ob Dreierpaket vorliegt
MsgBox "Übertragung aus RES wird nicht ausgeführt", vbCritical, "Daten inkonsistent"
Exit Sub '--Makro beenden
End If

'Prüfung übereinstimmung

For i = 1 To AnZ / 3
If Not wksQ.Cells(i, 4).Value = wksQ.Cells(AnZ / 3 + i, 4).Value Then
MsgBox "Fehler", vbCritical, "keine Übereinstimmung"
Exit Sub '--Makro beenden
End If
Next

For i = 1 To AnZ / 3
If Not wksQ.Cells(AnZ / 3 + i, 4).Value = wksQ.Cells(2 * AnZ / 3 + i, 4).Value Then
MsgBox "Fehler", vbCritical, "keine Übereinstimmung"
Exit Sub '--Makro beenden
End If
Next

'Benutzerkürzel einfügen

wksZ.Cells(wksZ.Cells(Rows.Count, 3).End(xlUp).Row + 1, 1).Resize(AnZ / 3, 1).Value = sTxt

'Einfügen in die 3 Sammler

wksZ.Cells(wksZ.Cells(Rows.Count, 3).End(xlUp).Row + 1, 3).Resize(AnZ / 3, 34).Value = wksQ.Cells(1, 1).Resize(AnZ / 3, 34).Value
'wksY.Cells(wksY.Cells(Rows.Count, 3).End(xlUp).Row + 1, 1).Resize(AnZ / 3, 34).Value = wksQ.Cells(1, 1).Resize(AnZ / 3, 34).Value
wksY.Cells(wksY.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(AnZ / 3, 34).Value = wksQ.Cells(AnZ / 3 + 1, 1).Resize(2 * AnZ / 3, 34).Value
wksX.Cells(wksX.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(AnZ / 3, 34).Value = wksQ.Cells(AnZ / 3 * 2 + 1, 1).Resize(AnZ, 34).Value

Sheets("Res").Cells.Clear
'''''''''
''''''''' Kopieren Sammler 4 nach RFA-Modul
'''''''''

Dim GluZ As Long
Dim AnZn As Long
GluZ = wksX.Cells(Rows.Count, 1).End(xlUp).Row
AnZn = GluZ + 1 - AnZ / 3

Dim wksQ4 As Worksheet
Dim wkbZ2 As Workbook
Dim wksZ2 As Worksheet
Dim strPfad As String
Dim strDatei As String

Set wksQ4 = Worksheets("4 Rohdaten gegl. Probe")

'Verzeichnis der Zieldatei
strPfad = "M:LaborRFA Analysen#RFA-Labormodul"
'Name der Zieldatei
strDatei = "RFATEST.xls"
If Dir(strPfad & "" & strDatei) = "" Then
MsgBox "Datei " & vbLf & strPfad & "" & strDatei & vbLf & "nicht gefunden"
Else

'Zieldatei öffnen
Set wkbZ2 = Application.Workbooks.Open(Filename:=strPfad & "" & strDatei)
Set wksZ2 = wkbZ2.Worksheets("Oxide")

'Benutzerkürzel einfügen
wksZ2.Cells(wksZ2.Cells(Rows.Count, 3).End(xlUp).Row + 1, 1).Resize(AnZ / 3, 1).Value = sTxt

'Werte von Sammler 4 einfügen
wksZ2.Cells(wksZ2.Cells(Rows.Count, 2).End(xlUp).Row + 1, 2).Resize(AnZ / 3, 33).Value = wksQ4.Cells(AnZn, 1).Resize(AnZ / 3, 33).Value

wkbZ2.Close SaveChanges:=True

End If

MsgBox "Die Ergebnisse können jetzt eingelesen werden.", vbInformation, "Helferlein"

Application.ScreenUpdating = True

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß Tobias

Edit:
Hier ist mein Versuch die zwei Bedingungen zu Verknüpfen:

Code:

For i = 1 To AnZ / 3
If Not wksQ.Cells(i, 4).Value = wksQ.Cells(AnZ / 3 + i, 4).Value And Not wksQ.Cells(AnZ / 3 + i, 4).Value = wksQ.Cells(2 * AnZ / 3 + i, 4).Value Then
MsgBox "Fehler", vbCritical, "keine Übereinstimmung"
Exit Sub '--Makro beenden
End If
Next
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

losgehts · 27. Januar 2020

Hallo,

ich habe es mir nicht näher angeschaut, aber bei dir fehlen in allen Pfadangaben die Backslashe:
Code:

"c:tempdemo.csv"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

"c:\tempdemo.csv"

und zwar überall!

Grüße, Ulrich

PS: das liegt vielleicht auch an der Forensoftware, da war irgendein Bug???

Flotter Feger · 28. Januar 2020

Hallo,

... ach ... den beiden geht es gut. Häckse muss sie einfach nur 2 Stunden ignorieren, bis sie müde sind. *wink.gif*

Ich hab mal ein wenig mit deiner CSV gespielt ...
Code:

Sub Makro2()
'
' Makro2 Makro
'

'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\1\Demo.csv", Destination:=Range("$A$1"))
.Name = "Demo_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Daten -> externe Daten abrufen -> aus Text
Dann durch den Text-Assi durch ... bei mir stellt es automatisch auf der ersten Seite in der ComboBox 'Dateiursprung', die Auswahl '65001 : Unicode (UTF-8)' ein. Falls nicht, musst du das auswählen.
Dann 'Weiter >' -> Komma abhaken und Semikolon anhaken, sonst trennt es auch deine Komma-Zahlen.
Wieder 'Weiter >' -> hier kannst du deine Datenformate einstellen. Ich habe alle auf Standard gelassen ... deshalb auch überall die 1 im Param-Array.
'Fertig' klicken und auswählen, wo die Daten hin sollen.

Sabina

Burt Macklin · 4. Februar 2020

Hallo Sabina!

Das ganze funktioniert wunderbar.

Aber es wird eine Verknüpfung angelegt. Ich lösche ja mein Blatt (Sheets("Res").Cells.Clear), aber die Verknüpfung bleibt. Das sehe ich unter Daten - Verbindungen. Kriege ich die wieder weg per Makro, bzw. wie erzeuge ich sie erst gar nicht?

Allerdings ist das ein Problem mit dem ich leben könnte. *cool.gif*

Gruß Tobias

Flotter Feger · 4. Februar 2020

Hallo Tobias,

wenn du das Tabellenblatt leerst, dann musst du doch nicht zwingend die Verknüpfung löschen.

Liest du die CSV nur ein einziges Mal ein ? Falls nicht, reicht es einfach die Verknüpfung zu aktualisieren, dann liest Excel die Datei neu ein.

Willst du die Verknüpfung aber tatsäschlich löschen, dann so ...

Sheets("Res").QueryTables("Demo_1").Delete '

Burt Macklin · 5. Februar 2020

Hallo Sabina!

Ich lese die Datei mehrmals am Tag ein.

Ich probiere das mit dem Aktualisieren mal aus. Ich hatte bedenken, dass sich massenhaft Verbindungen ansammeln wenn ich das Blatt nur leere.

Nochmal ein großes Dankeschön für die Unterstützung!

Gruß Tobias

Office: CSV und Sonderzeichen

CSV und Sonderzeichen

CSV und Sonderzeichen

CSV und Sonderzeichen

CSV und Sonderzeichen

CSV und Sonderzeichen

CSV und Sonderzeichen - Similar Threads - CSV Sonderzeichen

CSV in Outlook

CSV Verbindung ergänzt neue Spalten nicht

Makros für csv-Export mit Anführungszeichen für ausgewählte Splaten

CSV-Import mit seeehr langen Zahlen

Farbspeicherung in CSV-Datei

CSV Import

EXCEL 2010 Export.csv Dateien - Umlaute u. Sonderzeichen werden falsch dargestellt