Bereich in csv-Datei schreiben

Dieses Script speichert den mit der Maus selektierten Bereich semikolonsepariert als .csv-Datei. Zeilentrenner ist Chr(13).

Sub bereich_csv_export()
    'Dieses Werk oder Inhalt ist unter 
    'einer Creative Commons-Lizenz lizenziert.
    'www.hotcursors.de
    f = FreeFile(0)
    fname = Application.GetSaveAsFilename( _
            InitialFileName:=strInitName, _
            FileFilter:="Text-Dateien (*.txt), *.txt", _
            Title:="Datei exportieren")
    startrow = Selection.Row
    startcol = Selection.Column
    endrow = startrow + Selection.Rows.Count - 1
    endcol = startcol + Selection.Columns.Count - 1

    If fname <> False Then

        Open fname For Output As #f

        For nrow = startrow To endrow
            ausgabe_row = ""
            For col = startcol To endcol
                ausgabe_row = ausgabe_row + _
                     Cells(nrow, col).Text & ";"
            Next col
            ausgabe_row = Left(ausgabe_row, _
                 Len(ausgabe_row) - 1)

            Print #f, ausgabe_row

        Next nrow

        Close #f
    End If ' file
    MsgBox ("Export fertig.")
End Sub

Flattr this!

Kreuztabelle exportieren

wandelt eine Kreuztabelle in eine Tabelle um und exportiert diese in ein csv-File.

Die erste zu exportierende Zelle (in meinem Beispiel B3) anklicken und dann das Script ausführen. Anschließend Dateinahmen eingeben. Das Script exportiert die Kreuztabelle nun zeilenweise.

Daten in der Kreuztabelle
Daten in der Kreuztabelle
umgewandelte Kreuztabelle
umgewandelte Kreuztabelle

Sub kreuztabelle_exportieren()
    'Dieses Werk oder Inhalt ist unter 
    'einer Creative Commons-Lizenz lizenziert.
    'www.hotcursors.de
f = FreeFile(0)
fname = Application.GetSaveAsFilename( _
        InitialFileName:=strInitName, _
        FileFilter:="Text-Dateien (*.csv), *.csv", _
        Title:="Datei exportieren")
startrow = Selection.Row
startcol = Selection.Column
If fname <> False Then
    nrow = 0
    Open fname For Output As #f
    While Cells(startrow + nrow, startcol - 1).Value > ""
        kdnr = Cells(startrow + nrow, startcol - 1).Value
        col = 0
        ausgabe = ""
        While Cells(startrow - 1, startcol + _
             col).Value > ""
            If Cells(startrow + nrow, startcol + col)_
                     .Value > "" Then
                'reihen auslesen und schreiben
                ausgabe_row = ""
                For counter = 1 To startrow - 1
                    ausgabe_row = ausgabe_row & _
                         Cells(counter, startcol _ 
                               + col).Value & ";"
                Next counter
                'zeilen auslesen und schreiben
                ausgabe_col = ""
                For counter = 1 To startcol - 1
                    ausgabe_col = ausgabe_col &  _
                         Cells(startrow + nrow, _
                              counter).Value & ";"
                Next counter
                'datenpunkte auslesen und schreiben
                Print #f, ausgabe_row & ausgabe_col & _
                     Cells(startrow + nrow,  _
                          startcol + col).Value
            End If
            col = col + 1
        Wend
        nrow = nrow + 1
    Wend
    Close #f
End If ' file
MsgBox ("Export fertig.")
End Sub

Flattr this!