Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
992to996
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
992to996
992to996
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Kann man auch nur bestimmte Spalten exportieren?

Kann man auch nur bestimmte Spalten exportieren?
21.07.2008 21:12:00
Volker
Mittels dieses Makros

Sub SaveCSVUnicode()
Dim Bereich As Object, zeile As Object, Zelle As Object
Dim strTemp As String
Dim strDateiname As String
Dim strTrennzeichen As String
Dim strMappenpfad As String
Dim objFSO, objTextStream
strMappenpfad = ActiveWorkbook.FullName
strMappenpfad = Replace(strMappenpfad, ".xls", ".csv")
strDateiname = InputBox("Wie soll die CSV-Datei heißen (inkl. Pfad)?", "CSV-Export",  _
strMappenpfad)
If strDateiname = "" Then Exit Sub
strTrennzeichen = InputBox("Welches Trennzeichen soll verwendet werden?", "CSV-Export", ",")
If strTrennzeichen = "" Then Exit Sub
Set Bereich = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("B:AI"))
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextStream = objFSO.OpenTextFile(strDateiname, 2, True, -1)
For Each zeile In Bereich.Rows
' Cells(1) entspricht der Spalte B, wenn die Spalte B die erste Spalte ist
If zeile.Cells(1).Value = "e" Then
For Each Zelle In zeile.Cells
If InStr(1, Zelle.Text, strTrennzeichen) > 0 Then
'Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
strTemp = strTemp & """" & CStr(Zelle.Value) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Value) & strTrennzeichen
End If
Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1) &   _
_
Chr(10)
objTextStream.Write strTemp
strTemp = ""
End If
Next
objTextStream.Close
Set Bereich = Nothing
MsgBox "Datei wurde exportiert nach" & vbCrLf & strDateiname
End Sub


exportiere ich Daten aus einer Excel-Datei in eine Unicode-TXT-Datei.
Mittlerweile habe ich das Makro schon so angepasst, dass sich der zu exportierende Bereich auf Grund von


Set Bereich = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("B:AI"))


auf die Spalten B bis AI beschränkt. Gibt es noch eine Möglichkeit, das Ganze weiter einzuschränken? So, dass ich nur bestimmte Spalten auswählen kann? Also z.B. nur B, E bis K und P bis AI zusammen ...
Meine bisherigen Versuche


Set Bereich = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("B:B;E:K;PAI"))
Set Bereich = Intersect(ActiveSheet.UsedRange, Union(Range("B:B"),Range("E:K"),Range("PAI")))
Set Bereich = Intersect(ActiveSheet.UsedRange, Application.Union(Range("B:B"),Range("E:K"), _
Range("PAI")))


und ich glaube auch noch ein paar andere sind alle fehlgeschlagen :(
Wäre super, wenn mir jemand helfen könnte, wie das ggf. doch klappt ...

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kann man auch nur bestimmte Spalten exportieren?
21.07.2008 22:46:08
Jürgen
Hallo Ralf,
spontan würde mir einfallen, eine Liste der zu exportierenden Spalten(nummern) zu führen. Dann könntest Du wohl auch die Intersect-Zeile sparen. Nebenbei - warum nimmst Du nicht direkt den UsedRange? Eine Lösung könnte so aussehen (ungetestet, die Spaltennummern müssen natürlich noch angepaßt werden):

Sub SaveCSVUnicode()
Dim Bereich As Object, zeile As Object, Zelle As Object
Dim strTemp As String
Dim strDateiname As String
Dim strTrennzeichen As String
Dim strMappenpfad As String
Dim objFSO, objTextStream
Dim SpaltenListe() As Integer
Dim n As Integer
SpaltenListe = Split("1;3;4;5;6;10;13")
strMappenpfad = ActiveWorkbook.FullName
strMappenpfad = Replace(strMappenpfad, ".xls", ".csv")
strDateiname = InputBox("Wie soll die CSV-Datei heißen (inkl. Pfad)?", "CSV-Export", _
strMappenpfad)
If strDateiname = "" Then Exit Sub
strTrennzeichen = InputBox("Welches Trennzeichen soll verwendet werden?", "CSV-Export", ",")
If strTrennzeichen = "" Then Exit Sub
Set Bereich = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("B:AI"))
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextStream = objFSO.OpenTextFile(strDateiname, 2, True, -1)
For Each zeile In Bereich.Rows
' Cells(1) entspricht der Spalte B, wenn die Spalte B die erste Spalte ist
If zeile.Cells(1).Value = "e" Then
'For Each Zelle In zeile.Cells
For n = 0 To UBound(SpaltenListe)
Zelle = zeile.Cells(SpaltenListe(n))
If InStr(1, Zelle.Text, strTrennzeichen) > 0 Then
'Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
strTemp = strTemp & """" & CStr(Zelle.Value) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Value) & strTrennzeichen
End If
Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1) &  _
Chr(10)
objTextStream.Write strTemp
strTemp = ""
End If
Next
objTextStream.Close
Set Bereich = Nothing
MsgBox "Datei wurde exportiert nach" & vbCrLf & strDateiname
End Sub


Hast Du eigentlich bewußt die Text-Eigenschaft der Zellen verwendet? Damit riskierst (oder erreichst) Du, Zellinhalte abzuschneiden, wenn sie nicht in der gegebenen Spaltenbreite dargestellt werden können, da die Text-Eigenschaft das in der Zelle tatsächlich angezeigte zurückgibt (also auch "###", wenn die Zelle zu schmal ist). Andernfalls könntest Du die Value-Eigenschaft verwenden.
Gruß, Jürgen

Anzeige
AW: Kann man auch nur bestimmte Spalten exportieren?
21.07.2008 23:21:00
Volker
Fehlermeldung bzgl. Zeile

SpaltenListe = Split("1;3;4;5;6;10;13")


"Typen unverträglich"
Liegt wohl dran, dass Split sich auf einen String bezieht - Du aber mit int arbeiten willst!?
Bzgl. der Text-Eigenschaft: Nein, bin ich mir nicht bewusst (meine VBA-Kenntnisse sind leider sehr rudimentär) ... was meinst Du damit?
Das mit den ### kenne ich aus Excel, ja ... deshalb haben die entsprechenden Zellen dort nie Text, sondern Standard-Format - was die Darstellung dieser ### eigentlich bisher immer verhindert hat!?

Anzeige
AW: Kann man auch nur bestimmte Spalten exportieren?
22.07.2008 01:44:00
Volker
OK, ist gelöst. Makro sieht jetzt so aus:

Sub SaveCSVUnicode()
Dim Bereich As Object, Zelle As Object
Dim strTemp As String
Dim strDateiname As String
Dim strTrennzeichen As String
Dim strMappenpfad As String
Dim objFSO, objTextStream
Dim row_ As Long
Dim i As Long, irow As Long
strMappenpfad = ActiveWorkbook.FullName
strMappenpfad = Replace(strMappenpfad, ".xls", ".csv")
strDateiname = InputBox("Wie soll die CSV-Datei heißen (inkl. Pfad)?", "CSV-Export", _
strMappenpfad)
If strDateiname = "" Then Exit Sub
strTrennzeichen = InputBox("Welches Trennzeichen soll verwendet werden?", "CSV-Export", ",")
If strTrennzeichen = "" Then Exit Sub
row_ = Cells.SpecialCells(xlCellTypeLastCell).Row
Set Bereich = Union(Range("B1:B" & row_), Range("E1:K" & row_), Range("P1:AI" & row_))
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextStream = objFSO.OpenTextFile(strDateiname, 2, True, -1)
For irow = 1 To row_
If Cells(irow, 2).Value = "e" Then
For i = 1 To Bereich.Areas.Count
For Each Zelle In Bereich.Areas(i).Rows(irow).Cells
If InStr(1, Zelle.Text, strTrennzeichen) > 0 Then
'Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
strTemp = strTemp & """" & CStr(Zelle.Value) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Value) & strTrennzeichen
End If
Next
Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1)  _
& Chr(10)
objTextStream.Write strTemp
strTemp = ""
End If
Next
objTextStream.Close
Set Bereich = Nothing
MsgBox "Datei wurde exportiert nach" & vbCrLf & strDateiname
End Sub


Anzeige

315 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige