VBA Export - Feintuning | HERBERS Excel Forum

For Each LfdRow In SrcRg.Rows If Not LfdRow.EntireRow.Hidden Then 'Nur eingeblendete Zeilen werden ausgegeben - Zeilenanfang: ZeileStr = "" For Each LfdZelle In LfdRow.Cells With LfdZelle If Not .EntireColumn.Hidden Then 'Nur eingeblendete Spalten werden ausgegeben - Feldausgabe (Format hängt von Spalte ab): Select Case .Column Case 5: FeldStr = Replace(.Value, ";", ",") Case 6, 7: FeldStr = LCase(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(.Value, " ", ""), "ü", "ue"), "ä", "ae"), "ö", "oe"), "ß", "ss"), "\\", "-"), "/", "-"), "é", "e"), "è", "e")) Case Else: FeldStr = CStr(.Value) End Select 'Feld wird, eingeschlossen in "...", an Zeile angefügt, gefolgt vom Feldtrennzeichen ZeileStr = ZeileStr & Chr(34) & FeldStr & Chr(34) & FeldSep End If End With Next LfdZelle 'Am Zeilenende vorhandene Feldtrennzeichen werden aus der Zeile entfernt While Right(ZeileStr, 1) = FeldSep ZeileStr = Left(ZeileStr, Len(ZeileStr) - 1) Wend 'Die Zeile samt Zeilenendezeiche (und anschließendem CRLF) wird in die Datei ausgegeben. Print #DtN, ZeileStr & ZeileEnd End If Next LfdRow

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub InCSV_exportieren() Dim Z As Range Dim R As Range Const cTrenn = ";" Const dhk = """" For Each R In SrcRg.Rows If Not R.EntireRow.Hidden Then 'Nur eingeblendete Zeilen werden ausgegeben - Zeilenanfang: ZeileStr = "" For Each Z In R.Cells If Not Z.EntireColumn.Hidden Then 'Nur eingeblendete Spalten werden ausgegeben - Feldausgabe (Format hängt von Spalte ab): Select Case Z.Column Case 5: FeldStr = Replace(Z.Value, ";", ",") Case 6, 7: FeldStr = Replace_DE(Z.Value, (R.Row SrcRg.Row)) Case Else: FeldStr = CStr(Z.Value) End Select 'Feld wird, eingeschlossen in "...", an Zeile angefügt, gefolgt vom Feldtrennzeichen ZeileStr = ZeileStr & dhk & FeldStr & dhk & cTrenn End If Next Z 'Am Zeilenende vorhandene Feldtrennzeichen werden aus der Zeile entfernt Do While Right(ZeileStr, 1) = cTrenn ZeileStr = Left(ZeileStr, Len(ZeileStr) - 1) Loop 'Die Zeile samt Zeilenendezeiche (und anschließendem CRLF) wird in die Datei ausgegeben. Print #DtN, ZeileStr & ZeileEnd End If Next R End Sub Private Function Replace_DE(Eingang As String, Optional MacheLCase = True) As String Dim Erg As String Erg = Replace(Eingang, " ", "") 'als erste, weil es die Anzahl an Zeichen reduziert If MacheLCase Then Erg = LCase(Erg) Else Erg = Replace(Erg, "Ü", "Ue") Erg = Replace(Erg, "Ä", "Ae") Erg = Replace(Erg, "Ö", "Oe") Erg = Replace(Erg, "É", "E") Erg = Replace(Erg, "È", "E") End If Erg = Replace(Erg, "\\", "-") Erg = Replace(Erg, "/", "-") Erg = Replace(Erg, "é", "e") Erg = Replace(Erg, "è", "e") Erg = Replace(Erg, "ü", "ue") Erg = Replace(Erg, "ä", "ae") Erg = Replace(Erg, "ö", "oe") Erg = Replace(Erg, "ß", "ss") Replace_DE = Erg End Function

Hallo Mat,
LCase wird in der abgelagerten Function Replace_DE gemacht. Als zweite Parameter wird einen Boolsche "MacheLCase" angenommen, das ausgelassen werden darf und per Default True ist, aber in Case 6 wird als zweiten Parameter übergeben ob die aktuelle Zeile gleich (bzw ungleich) die erste Zeile ist. Bei erster Zeile ist es gleich also R.Row SrcRg.Row ist False. Kein LCase.
Deine Angabe sind widersprüchlich: Spalte 6 nicht exportieren, Spalte 6 einen Zusatz geben (und dann nicht exportieren? macht keinen Sinn)
Im Folgenden gibt es zwei Case 6: der erste setzt eine Variable Überspringe auf True, der zweite fügt einen Text an Spalte 6. Beide gleichzeitig wird nicht funktionieren. Da musst Du dich reinkniehen und im Klaren sein, was Du brauchst/willst und den Code dementsprechend zurecht biegen.


Sub InCSV_exportieren()
Dim Z As Range
Dim R As Range
Dim ÜberSpringe As Boolean
Const cTrenn = ";"
Const dhk = """"
For Each R In SrcRg.Rows
If Not R.EntireRow.Hidden Then
'Nur eingeblendete Zeilen werden ausgegeben - Zeilenanfang:
ZeileStr = ""
For Each Z In R.Cells
ÜberSpringe = False 'default immer resetten
If Not Z.EntireColumn.Hidden Then
'Nur eingeblendete Spalten werden ausgegeben - Feldausgabe (Format hängt von Spalte ab):
Select Case Z.Column
Case 5:    FeldStr = Replace(Z.Value, ";", ",")
Case 6:    ÜberSpringe = True
Case 6:    FeldStr = Z.Value & " irgendein Text"
Case 7:    FeldStr = Replace_DE(Z.Value, (R.Row  SrcRg.Row))
Case Else: FeldStr = CStr(Z.Value)
End Select
'Feld wird, eingeschlossen in "...", an Zeile angefügt, gefolgt vom Feldtrennzeichen
If Not ÜberSpringe Then ZeileStr = ZeileStr & dhk & FeldStr & dhk & cTrenn
End If
Next Z
'Am Zeilenende vorhandene Feldtrennzeichen werden aus der Zeile entfernt
Do While Right(ZeileStr, 1) = cTrenn
ZeileStr = Left(ZeileStr, Len(ZeileStr) - 1)
Loop
'Die Zeile samt Zeilenendezeiche (und anschließendem CRLF) wird in die Datei ausgegeben.
Print #DtN, ZeileStr & ZeileEnd
End If
Next R
End Sub
Private Function Replace_DE(Eingang As String, Optional MacheLCase = True) As String
Dim Erg As String
Erg = Replace(Eingang, " ", "")  'als erste, weil es die Anzahl an Zeichen reduziert
If MacheLCase Then
Erg = LCase(Erg)
Else
Erg = Replace(Erg, "Ü", "Ue")
Erg = Replace(Erg, "Ä", "Ae")
Erg = Replace(Erg, "Ö", "Oe")
Erg = Replace(Erg, "É", "E")
Erg = Replace(Erg, "È", "E")
End If
Erg = Replace(Erg, "\\", "-")
Erg = Replace(Erg, "/", "-")
Erg = Replace(Erg, "é", "e")
Erg = Replace(Erg, "è", "e")
Erg = Replace(Erg, "ü", "ue")
Erg = Replace(Erg, "ä", "ae")
Erg = Replace(Erg, "ö", "oe")
Erg = Replace(Erg, "ß", "ss")
Replace_DE = Erg
End Function

VG
Yal

Beliebteste Forumthreads (12 Monate)

VBA Export - Feintuning

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread