Hallo zusammen,
habe ein kleines Problem dabei, gezielt Werte aus einem Excel-Formular auszulesen und anschließend in eine CSV zu exportieren.
Dieses Formular umfasst knapp 20 Spalten und ist 80 Zeilen lang. Aus diesem Formular möchte ich gerne einzelne Zellen auslesen und anschließend in eine CSV Datei exportieren.
Mittlerweile habe ich ein VBA-Skript vorliegen, dass prinzipiell dem nachkommt. Sprich einen Zellenbereich ausliest und mir anschließend eine CSV Datei bastelt. Dieses Skript ist aber leider auf die ersten zwei Werte beschränkt (z.B. unten im Code C6 und c9). Und ich verstehe nicht warum. Ich würde gerne mehrere einzelne Werte aus verschiedenen Zellen exportieren.
z.B. C6, C9, aa11 usw. Das Skript soll immer die selben Zellen aus den immer gleich aussehenden Formularen auslesen. Also muss nicht flexibel sein. Nur die Zellen, die vorgegeben werden sind viele einzelne. Über Hilfe oder Tipps würde ich mich sehr freuen.
Anbei das funktionsfähige Skript, dass ich derzeit nutze:
Sub TestRange()
Dim ws As Worksheet, fd As FileDialog, rngTest As Range, rngExport As Range, fltr As FileDialogFilter, r1, r2, myMultipleRange As Range
'Worksheet auf dem die Daten stehen
Set ws = Worksheets(1)
'Bereich der exportiert wird
Set r1 = ws.Range("c6", "c9")
Set r2 = ws.Range("aa11", "ac11")
Set myMultipleRange = Union((r1), (r2))
'Zelle die auf Inhalt überprüft werden soll
Set rngTest = ws.Range("c4")
Set rngExport = myMultipleRange
If rngTest <> "" Then
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.Title = "Wählen sie einen Namen unter der die CSV-Datei gespeichert werden soll"
'Filterindex für CSV-Dateien ermitteln
'Gets or sets the current file name filter string, which determines the choices that appears in the save as "file type" or "files of type box" in die dialog box
For i = 1 To .Filters.Count
If .Filters(i).Extensions = "*.csv" Then
.FilterIndex = i
Exit For
End If
Next
'Wenn OK geklickt wurde starte Export
If .Show = True Then
ExportRangeAsCSV rngExport, ";", .SelectedItems(1)
End If
End With
End If
End Sub
'Prozedur für den Export eines Ranges in eine CSV-Datei
Sub ExportRangeAsCSV(ByVal rng As Range, delim As String, filepath As String)
Dim arr As Variant, line As String, csvContent As String, fso As Object, csvFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set csvFile = fs
penTextFile(filepath, 2, True)
arr = rng.Value
If IsArray(arr) Then
For r = 1 To UBound(arr, 1)
line = ""
For c = 1 To UBound(arr, 2)
If c < UBound(arr, 2) Then
line = line & """" & arr(r, c) & """" & delim
Else
line = line & """" & arr(r, c) & """"
End If
Next
csvContent = csvContent & line & vbNewLine
Next
csvFile.Write (csvContent)
csvFile.Close
Else
MsgBox "Bereich besteht nur aus einer Zelle!", vbExclamation
End If
Set fso = Nothing
Set csvFile = Nothing
End Sub
habe ein kleines Problem dabei, gezielt Werte aus einem Excel-Formular auszulesen und anschließend in eine CSV zu exportieren.
Dieses Formular umfasst knapp 20 Spalten und ist 80 Zeilen lang. Aus diesem Formular möchte ich gerne einzelne Zellen auslesen und anschließend in eine CSV Datei exportieren.
Mittlerweile habe ich ein VBA-Skript vorliegen, dass prinzipiell dem nachkommt. Sprich einen Zellenbereich ausliest und mir anschließend eine CSV Datei bastelt. Dieses Skript ist aber leider auf die ersten zwei Werte beschränkt (z.B. unten im Code C6 und c9). Und ich verstehe nicht warum. Ich würde gerne mehrere einzelne Werte aus verschiedenen Zellen exportieren.
z.B. C6, C9, aa11 usw. Das Skript soll immer die selben Zellen aus den immer gleich aussehenden Formularen auslesen. Also muss nicht flexibel sein. Nur die Zellen, die vorgegeben werden sind viele einzelne. Über Hilfe oder Tipps würde ich mich sehr freuen.
Anbei das funktionsfähige Skript, dass ich derzeit nutze:
Sub TestRange()
Dim ws As Worksheet, fd As FileDialog, rngTest As Range, rngExport As Range, fltr As FileDialogFilter, r1, r2, myMultipleRange As Range
'Worksheet auf dem die Daten stehen
Set ws = Worksheets(1)
'Bereich der exportiert wird
Set r1 = ws.Range("c6", "c9")
Set r2 = ws.Range("aa11", "ac11")
Set myMultipleRange = Union((r1), (r2))
'Zelle die auf Inhalt überprüft werden soll
Set rngTest = ws.Range("c4")
Set rngExport = myMultipleRange
If rngTest <> "" Then
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.Title = "Wählen sie einen Namen unter der die CSV-Datei gespeichert werden soll"
'Filterindex für CSV-Dateien ermitteln
'Gets or sets the current file name filter string, which determines the choices that appears in the save as "file type" or "files of type box" in die dialog box
For i = 1 To .Filters.Count
If .Filters(i).Extensions = "*.csv" Then
.FilterIndex = i
Exit For
End If
Next
'Wenn OK geklickt wurde starte Export
If .Show = True Then
ExportRangeAsCSV rngExport, ";", .SelectedItems(1)
End If
End With
End If
End Sub
'Prozedur für den Export eines Ranges in eine CSV-Datei
Sub ExportRangeAsCSV(ByVal rng As Range, delim As String, filepath As String)
Dim arr As Variant, line As String, csvContent As String, fso As Object, csvFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set csvFile = fs
penTextFile(filepath, 2, True)arr = rng.Value
If IsArray(arr) Then
For r = 1 To UBound(arr, 1)
line = ""
For c = 1 To UBound(arr, 2)
If c < UBound(arr, 2) Then
line = line & """" & arr(r, c) & """" & delim
Else
line = line & """" & arr(r, c) & """"
End If
Next
csvContent = csvContent & line & vbNewLine
Next
csvFile.Write (csvContent)
csvFile.Close
Else
MsgBox "Bereich besteht nur aus einer Zelle!", vbExclamation
End If
Set fso = Nothing
Set csvFile = Nothing
End Sub
Zuletzt bearbeitet: