VBA > nur bestimmte Spalten und Zeilen

Kalito

Erfahrenes Mitglied
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.

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";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
"";"";"";"";"";"";"";"";"";""
 
Visual Basic:
    For Each rngRow In rngRange.Rows
        'Nur exportieren, wenn der Range nicht leer ist
        If WorksheetFunction.CountA(rngRow) > 0 Then objStream.WriteText CsvFormatRow(rngRow)
    Next rngRow
 
Zurück