markierte Zellen als einzelne CSV abspeichern

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: markierte Zellen als einzelne CSV abspeichern
von: Ralf B.
Geschrieben am: 24.09.2015 17:08:02

Hallo miteinander,
ich habe folgendes Problem, und hoffe das mir jemand helfen kann.
Aus einer Tabelle sollen markierte Zellen mit einigen Festen Werten aus dieser Tabelle als einzelne CSV (; getrennt) abgespeichert werden. Diese CSV's enthalten dann nur die Zeile 1 Daten. Diese soll sich folgendermaßen zusammensetzen: "Wert aus C3;akt.Datum(dd.mm.jjjj);akt.Zeit(hh.mm.ss);markierter Bereich immer aus Spalte D);Wert aus C9;;;;Wert aus c5;Wert aus F5;Wert aus E7".
Der Dateiname der CSV sollte sich aus dem akt.Datum/Uhrzeit zusammensetzen (jjjj-mm-dd-hh-mm-ss-(wenn gleiche Sekunde noch eine fortlaufende Nummer,sonst langt eine 1)).
Den Speicherpfad könnte mann direkt im Makro editieren oder ich würde ihn in eine
Zelle (im Beispiel L3) hinterlegen).
Wenn ich z.B. Zellen D17:D22 markieren würde sollten 6 CSV-Dateien (siehe angehängtes Muster) erzeugt werden.
Wäre so etwas umzusetzen? Wenn ja wäre es toll und mir jede Menge händische Arbeit ersparen.
War leider schlecht zu erklären aber anhand der Beispiele vielleicht doch verständlich.
Hier der Link zu den Beispieldateien:
https://www.herber.de/bbs/user/100374.zip
Vielen Dank schon mal im voraus...
Gruß Ralf

Bild

Betrifft: AW: markierte Zellen als einzelne CSV abspeichern
von: fcs
Geschrieben am: 24.09.2015 19:06:47
Hallo Ralf,
hier ein entsprechendes Makro.
Gruß
Franz

Sub Generate_CSV_from_Selection()
    Dim wks As Worksheet, rngBereich As Range, lngI As Long
    Dim strCSV As String, strPfad As String
    Dim intFF As Integer
    Dim strDatum As String, strZeit As String, strText As String
    
    Set rngBereich = Selection
    If rngBereich.Column <> 4 Or rngBereich.Columns.Count > 1 Then
        MsgBox "Bitte nur einen Zellbereich in Spalte D selektieren!", _
            vbOKOnly, "Makro: Generate_CSV_from_Selection"
    Else
        Set wks = ActiveSheet
        strPfad = wks.Range("L3").Text & Application.PathSeparator  '"C:\Users\Public\Test"
        strDatum = Format(Date, "DD.MM.YYYY")
        strZeit = Format(Time, "hh:mm:ss")
        strCSV = strPfad & Format(Now, "YYYY-MM-DD-hh-mm-ss-")
        For lngI = 1 To rngBereich.Cells.Count
'            If rngBereich.Cells(lngI, 1) <> "" Then
            intFF = VBA.FreeFile()
            Open strCSV & Format(lngI, "00") & ".csv" For Output As intFF
            With wks
                strText = .Range("C3").Value & ";" _
                    & strDatum & ";" & strZeit & ";" _
                    & rngBereich.Cells(lngI, 1).Value & ";" _
                    & .Range("C9") & ";;;;" _
                    & .Range("C5") & ";" _
                    & .Range("F5") & ";" _
                    & .Range("E7")
            End With
            Print #intFF, strText
            Close intFF
'            End If
        Next
    End If
End Sub


Bild

Betrifft: AW: markierte Zellen als einzelne CSV abspeichern
von: Ralf B.
Geschrieben am: 24.09.2015 19:52:19
Hallo Franz,
wie bisher alle deine Lösungen...PERFEKT.
Muss nur das Layout verändern, da es mit verbundenen Zellen nicht funktioniert. Ist aber das kleinste Übel.
Eine Frage hätte ich noch:
Ist es möglich, die Zeilen, aus denen man die Werte extrahiert hat farblich zu markieren?
Das hätte den Vorteil, das man nicht aus versehen Daten 2 Mal exportiert. Das würde das nachgeschaltete automatisierte System bestimmt ordentlich durcheinanderbringen.
Wenn das nicht möglich ist natürlich auch so meinen herzlichsten Dank.
Gruß Ralf

Bild

Betrifft: AW: markierte Zellen als einzelne CSV abspeichern
von: fcs
Geschrieben am: 24.09.2015 22:53:23
Hallo Ralph,
die Werte in Spalte D jeweils zu markieren ist kein Problem.
Bei Verwendung von Cells statt Range sollten auch die verbundenen Zellen weniger Probleme machen.
Gruß
Franz

Sub Generate_CSV_from_Selection()
    Dim wks As Worksheet, rngBereich As Range, lngI As Long
    Dim strCSV As String, strPfad As String
    Dim intFF As Integer
    Dim strDatum As String, strZeit As String, strText As String
    
    Set rngBereich = Selection
    If rngBereich.Column <> 4 Or rngBereich.Columns.Count > 1 Then
        MsgBox "Bitte nur einen Zellbereich in Spalte D selektieren!", _
            vbOKOnly, "Makro: Generate_CSV_from_Selection"
    Else
        Set wks = ActiveSheet
        strPfad = wks.Range("L3").Text & Application.PathSeparator  '"C:\Users\Public\Test"
        strDatum = Format(Date, "DD.MM.YYYY")
        strZeit = Format(Time, "hh:mm:ss")
        strCSV = strPfad & Format(Now, "YYYY-MM-DD-hh-mm-ss-")
        For lngI = 1 To rngBereich.Rows.Count
'            If rngBereich.Cells(lngI, 1) <> "" Then
            intFF = VBA.FreeFile()
            Open strCSV & Format(lngI, "00") & ".csv" For Output As intFF
            With wks
                strText = .Cells(3, 3).Value & ";" _
                    & strDatum & ";" & strZeit & ";" _
                    & rngBereich.Cells(lngI, 1).Value & ";" _
                    & .Cells(9, 3) & ";;;;" _
                    & .Cells(5, 3) & ";" _
                    & .Cells(5, 6) & ";" _
                    & .Cells(7, 5)
            End With
            Print #intFF, strText
            Close intFF
'            End If
        Next
        rngBereich.Interior.Color = RGB(Red:=0, Green:=255, Blue:=0) 'grün
        
    End If
End Sub


Bild

Betrifft: AW: markierte Zellen als einzelne CSV abspeichern
von: Ralf B.
Geschrieben am: 25.09.2015 07:48:47
Hallo Franz,
die anderen User hier im Forum sind ja schon gut....
Deine Lösungen sind aber so was auf den Punkt, das ich immer hoffe du nimmst dich meiner an.
Du brauchst für die exakte Lösung kürzer als ich zum formulieren.
Nochmals vielen, vielen Dank
Gruß Ralf

 Bild

Beiträge aus den Excel-Beispielen zum Thema "markierte Zellen als einzelne CSV abspeichern"