Hallo,
ich habe von einem ausgeschiedenen Kollegen ein Makro übernommen. Bei diesem werden Excel-Tabellen in CSV-Dateien gespeichert. Jedoch werden auch hin und wieder leere Zeilen und Spalten mit reinkopiert (siehe IST.csv). Wie kann ich unterbinden, dass komplette leerzeilen oder leer-Spalten mit übernommen werden. Am Ende sollte die SOLL.csv rausfallen.
Danke.
SOLL.csv
IST.csv
ich habe von einem ausgeschiedenen Kollegen ein Makro übernommen. Bei diesem werden Excel-Tabellen in CSV-Dateien gespeichert. Jedoch werden auch hin und wieder leere Zeilen und Spalten mit reinkopiert (siehe IST.csv). Wie kann ich unterbinden, dass komplette leerzeilen oder leer-Spalten mit übernommen werden. Am Ende sollte die SOLL.csv rausfallen.
Danke.
Code:
Option Explicit
Const strDelimiter = """"
Const strDelimiterEscaped = strDelimiter & strDelimiter
Const strSeparator = ";"
Const strRowEnd = vbCrLf
Const strCharset = "utf-8"
Function CsvFormatString(strRaw As String) As String
Dim strFormatted As String
strFormatted = Replace(strRaw, Chr(10), "<br />")
strFormatted = Replace(strFormatted, strDelimiter, "'")
strFormatted = Replace(strFormatted, "<br>", "<br />")
CsvFormatString = strDelimiter & strFormatted & strDelimiter
End Function
Function CsvFormatRow(rngRow As Range) As String
Dim arrCsvRow() As String
ReDim arrCsvRow(rngRow.Cells.Count - 1)
Dim rngCell As Range
Dim lngIndex As Long
lngIndex = 0
For Each rngCell In rngRow.Cells
arrCsvRow(lngIndex) = CsvFormatString(rngCell.Text)
lngIndex = lngIndex + 1
Next rngCell
CsvFormatRow = Join(arrCsvRow, strSeparator) & strRowEnd
End Function
Sub CsvExportRange( _
rngRange As Range, _
Optional strFileName As Variant _
)
Dim rngRow As Range
Dim objStream As Object
If IsMissing(strFileName) Or IsEmpty(strFileName) Then
strFileName = Application.GetSaveAsFilename( _
InitialFileName:=ActiveWorkbook.Path & "\" & rngRange.Worksheet.Name & ".csv", _
FileFilter:="CSV (*.csv), *.csv", _
Title:="Export CSV")
End If
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = 2
objStream.Charset = strCharset
objStream.Open
For Each rngRow In rngRange.Rows
objStream.WriteText CsvFormatRow(rngRow)
Next rngRow
'skip BOM
objStream.Position = 3
Dim BinaryStream As Object
Set BinaryStream = CreateObject("adodb.stream")
BinaryStream.Type = 1
BinaryStream.Mode = 3
BinaryStream.Open
objStream.CopyTo BinaryStream
objStream.Flush
objStream.Close
BinaryStream.SaveToFile strFileName, 2
BinaryStream.Flush
BinaryStream.Close
End Sub
Sub CsvExportSelection()
CsvExportRange ActiveWindow.Selection
End Sub
Sub CsvExportSheet(varSheetIndex As Variant)
Dim wksSheet As Worksheet
Set wksSheet = Sheets(varSheetIndex)
CsvExportRange wksSheet.UsedRange
End Sub
SOLL.csv
Code:
"Test-ID";"Ersteller";"Tags";"Testfall";"Beschreibung";"Prioritaet";"Vorbedingung";"Testschritt";"Erwartung";"Aktion"
"431-001-01";"pak";"test,test 2";"Ich bin ein Testfall";"Beschreibung";"mittel";"Vorbedingung";"";"";"i"
"";"";"";"";"";"";"";"Testschritt 1";"Erwartung 1";""
"";"";"";"";"";"";"";"Testschritt 2";"Erwartung 2";""
"431-001-02";"pak";"test,test 2";"Ich bin ein Testfall";"Beschreibung";"hoch";"Vorbedingung";"";"";""
"";"";"";"";"";"";"";"Testschritt 11";"Erwartung 11";""
"";"";"";"";"";"";"";"Testschritt 21";"Erwartung 21";""
IST.csv
Code:
"Test-ID";"Ersteller";"Tags";"Testfall";"Beschreibung";"Prioritaet";"Vorbedingung";"Testschritt";"Erwartung";"Aktion"
"431-001-01";"pak";"test,test 2";"Ich bin ein Testfall";"Beschreibung";"mittel";"Vorbedingung";"";"";"i"
"";"";"";"";"";"";"";"Testschritt 1";"Erwartung 1";""
"";"";"";"";"";"";"";"Testschritt 2";"Erwartung 2";""
"431-001-02";"pak";"test,test 2";"Ich bin ein Testfall";"Beschreibung";"hoch";"Vorbedingung";"";"";""
"";"";"";"";"";"";"";"Testschritt 11";"Erwartung 11";""
"";"";"";"";"";"";"";"Testschritt 21";"Erwartung 21";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""