Speichern, Tabs raus, Konvertieren

Forumthread: Speichern, Tabs raus, Konvertieren

19.09.2017 14:21:35

Peter(silie)

Hallo Leute,
dieser Thread knüpft indirekt an diesen hier an: 1581205
Folgendes Prozedere:
CSV importieren --> Werte bearbeiten --> als txt Speichern -->
die durch die Zellen entstandenen Tabs entfernen --> "Konvertieren"
Wenn ich meine Datei in eine Textdatei konvertiere, dann entsteht
nach jeder befüllten Zelle ein Tab

(Bsp.:
INCHES OR MM:
READINGS
EMPTY 	EMPTY 	EMPTY 	EMPTY 	EMPTY 	EMPTY 	EMPTY 	EMPTY
)

Diese Tabs, dürfen aber nicht drinnen sein, deshalb entferne
ich diese später mit Replace, damit das ganze so aussieht:

INCHES OR MM:
READINGS
EMPTY EMPTY EMPTY EMPTY EMPTY EMPTY EMPTY EMPTY

Folgenden Code verwende ich:


'//Safe the Import As TextFile
Private Sub SafeAsText()
Dim workbook_ As Workbook
Dim wbPath As String
Application.DisplayAlerts = False
Set workbook_ = Workbooks.Add
ThisWorkbook.Sheets(1).Copy After:=workbook_.Sheets(1)
workbook_.Sheets(1).Delete
workbook_.WebOptions.Encoding = msoEncodingUSASCII
workbook_.SaveAs Filename:=DefaultPath & Mid(SplitCsvName, 1, Len(SplitCsvName) - 4),  _
FileFormat:=xlText
wbPath = workbook_.FullName
workbook_.Close False
Application.DisplayAlerts = True
EraseTabulator wbPath
End Sub
'//Replace Tab with 1-Spacebar hit and convert to .dat
Private Sub EraseTabulator(ByVal file_ As Variant)
Dim data_ As String
Dim newData As String
Dim free_ As Long
free_ = FreeFile
Open file_ For Input As #free_
Do Until EOF(free_)
Line Input #free_, data_
data_ = Replace(data_, vbTab, " ", , , vbTextCompare)
newData = newData & data_ & vbCrLf
Loop
Close #free_
free_ = FreeFile
Open file_ For Output As #free_
Print #free_, newData
Close #free_
Name file_ As Mid(file_, 1, Len(file_) - 4) & ".dat"
End Sub

Der kommt zwar von mir, grausam finde ich ihn trotzdem...
Kennt ihr Möglichkeiten das ganze vielleicht etwas smarter und schöner zu gestalten?

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Speichern, Tabs raus, Konvertieren

19.09.2017 17:19:59

fkw48
AW: Speichern, Tabs raus, Konvertieren

19.09.2017 18:58:04

Peter
Danke fkw48 + Code für Import u. Speichern v. Csv

20.09.2017 09:22:35

Peter(silie)

AW: Speichern, Tabs raus, Konvertieren

19.09.2017 17:19:59

fkw48


Sub Makro1()
'CSV importieren --> Werte bearbeiten     ERLEDIGT!
'--> als txt Speichern                    JETZT!
Dim oWB As Workbook
Dim rngRw As Range
For Each oWB In Workbooks
If Right(oWB.Name, 4) = ".csv" Then Exit For
Next oWB
If oWB Is Nothing Then Exit Sub
Open "E:\Temp\Test.txt" For Output As #1
For Each rngRw In oWB.Sheets(1).UsedRange.Rows
Print #1, Join(Application.Transpose(Application.Transpose(rngRw.Value)), " ")
Next rngRw
Close #1
End Sub

AW: Speichern, Tabs raus, Konvertieren

19.09.2017 18:58:04

Peter

Hallo,
probiere ich morgen gleich mal aus, sieht vielversprechend aus.
Danke!

Danke fkw48 + Code für Import u. Speichern v. Csv

20.09.2017 09:22:35

Peter(silie)

Hallo Leute,
nochmal ein Dankeschön an fkw48.
Code macht folgendes:
- Lass Nutzer eine CSV-Datei auswählen
- Importiere die Daten
- Speichere das Worksheet mit den Daten als .dat
(Mein original Code bearbeitet noch die Daten, die Prozeduren dafür
sind aber unwichtig für jeden außer mir)
Code:

Option Explicit
'	Module wide Variables
Private worksheet_ As Worksheet
Private DefaultPath As String
Private TmpPath As String
Private csv_ As String
'	Can be Called from outside
'	Executes the below Code for
'	importing csv and saving it as .dat
Public Sub Import()
DefaultPath = Environ("Userprofile") & "\Documents\"
TmpPath = DefaultPath & "tmp_.txt"
Set worksheet_ = ThisWorkbook.Sheets(1)
worksheet_.UsedRange.Clear
'//Select File
csv_ = CsvFilePath
If csv_ = "" Then Exit Sub
'//Import the Data
AddCSV
'//Safe File as Dat
CreateDatFile
'//Clear Connection To imported File
ClearConnections
End Sub
'	Let User select file
Private Function CsvFilePath() As String
Dim FileDialog_ As FileDialog
Dim selection_
Set FileDialog_ = Application.FileDialog(msoFileDialogFilePicker)
With FileDialog_
.Filters.Add "CSV", "*.csv", 1
.AllowMultiSelect = False
.InitialFileName = DefaultPath
If .Show = -1 Then
For Each selection_ In .SelectedItems
CsvFilePath = selection_
Next selection_
End If
End With
Set FileDialog_ = Nothing
End Function
'	Import the csv File
'	This code comes from the
'	macro recorder
Private Sub AddCSV()
With worksheet_.QueryTables.Add(Connection:="TEXT;" & csv_, _
Destination:=Range("A1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlMSDOS
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
'	Extract the csv File Name
Private Function SplitCsvName() As String
Dim array_() As String
array_ = Split(csv_, "\")
SplitCsvName = array_(UBound(array_))
Erase array_
End Function
'	Write Sheet Values in Tmp File and Save it as .dat
Private Sub CreateDatFile()
Dim splittedName As String
Dim workbook_ As Workbook
Dim rng As Range
Dim file_ As Long
'//Get the Name of the csv File
splittedName = SplitCsvName
'//Check if Tmp File Exists, if not then Create it
If Dir(TmpPath, vbDirectory) = vbNullString Then CreateTmpFile
file_ = FreeFile
Open TmpPath For Output As #file_
Set workbook_ = ThisWorkbook
For Each rng In workbook_.Sheets(1).UsedRange.Rows
Print #file_, Join(Application.Transpose(Application.Transpose(rng.Value)), " ")
Next rng
Close #file_
Name TmpPath As DefaultPath & Mid(splittedName, 1, Len(splittedName) - 4) & ".dat"
Set workbook_ = Nothing
End Sub
'	If the tmp File doenst exist then create it
Private Sub CreateTmpFile()
Dim fso As Object
Dim file_ As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set file_ = fso.CreateTextFile(TmpPath)
file_.Close
Set file_ = Nothing
Set fso = Nothing
End Sub
'	Delete Connection(s) that where added by Sub: AddCsv
Private Sub ClearConnections()
Dim varConnection As Variant
For Each varConnection In ThisWorkbook.Connections
varConnection.Delete
Next varConnection
End Sub

Beliebteste Forumthreads (12 Monate)

Speichern, Tabs raus, Konvertieren

Forumthread: Speichern, Tabs raus, Konvertieren

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread