导出一个范围到新的csv文件,但第一行应该是清晰的



这段代码将我想要的值范围导出到一个新的csv文件,但它应该从第2行开始,所以我可以用标题(另一个范围值)填充第一行。

Sub TestRange()
Dim ws As Worksheet, fd As FileDialog, rngTest As Range, rngExport As Range, fltr As FileDialogFilter
Dim start As Long
start = 2
'    Dim jahr As Integer

'   jahr = Date

'Nach jeweiliger Zeit wird Datenreihe (start ab) ausgewählt
If Time < TimeValue("11:15") Then
Do Until Daten.Range("ov" & start) = Date + 1
start = start + 1
Loop
Else
Do Until Daten.Range("ov" & start) = Date + 2
start = start + 1
Loop
End If

'Worksheet auf dem die Daten stehen
Set ws = Worksheets("Daten")

'Zelle die auf Inhalt überprüft werden soll
Set rngTest = ws.Range("ov2")
'Bereich der exportiert wird
Set rngExport = ws.Range("ov" & start & ":ow5000")
If rngTest.Text <> "" Then
Set fd = Application.FileDialog(msoFileDialogSaveAs)
'Filename
fd.InitialFileName = "LG" & " " & Diagramm.Range("a5").Value & " " & "RZ" & " " & Format(Date, "mmmm") & " " & Format(Date, "yyyy") & "_" & "MW" & "_" & "ab" & " " & Daten.Range("ov" & start).Value
' Application.Dialogs(xlDialogSaveAs).Show filenameComplete
With fd
.Title = ""
'Filterindex für CSV-Dateien ermitteln
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 = fso.OpenTextFile(filepath, 2, True)

arr = rng.Value 'Filter
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 

我从网上复制了这段代码,它可以工作,但是我找不到解决方案。

我怎样才能改变代码,使我的csv文件有第一行清晰,这样我就可以在第一行写两列的标题?

If IsArray(arr) Then
' new code
Dim col as range
For Each col In rng.Columns
If Len(line) > 0 Then line = line & delim
line = line & """" & rng.Parent.Cells(1, col.Column) & """"
Next
csvContent = line & vbNewLine
' existing code
For r = 1 To UBound(arr, 1)

最新更新