Microsoft Excel

Herbers Excel/VBA-Archiv

Bitte um Hilfe bei csv-Export | Herbers Excel-Forum


Betrifft: Bitte um Hilfe bei csv-Export von: Tom Finnland
Geschrieben am: 27.07.2012 19:43:12

Hallo liebe Forumsmitglieder,
bitte um Hilfe bei folgendem Problem: Ich habe eine Excel-Datei mit ca. 600 Datensätzen/Zeilen, diese muß ich nach verschiedenen Kriterien zu Gruppen zusammenfassen (in der Beispieldatei durch die ID angedeutet), anschließend pro Gruppe einige Felder manuell in ein neues Blatt kopieren und als csv-Datei abspeichern-und das so ca. 70 mal:-(( würde das jetzt gern wie folgt per vba automatisieren: ich markiere die Zeilen die einer Gruppe entsprechen (in der Beispieldatei farbig hinterlegt) - filtere irgendwie die Felder die ich brauche heraus und speichere das ganze als csv-Datei in einem Ordner dessen Pfad immer gleich bleibt, und der Speichername sollte sich aus SuffixKW_ID ergeben-also im Beispiel "Benord30_4". Ich hab leider nur ganz spärliche VBA-Kentnisse und würde mich über jede Hilfestellung/Tip sehr freuen!!
Hier noch der Link zur Beispieldatei
https://www.herber.de/bbs/user/81181.xls

LG und vielen Dank schon mal im voraus
Thomas

  

Betrifft: AW: Bitte um Hilfe bei csv-Export von: Reinhard
Geschrieben am: 28.07.2012 10:45:22

Hallo Thomas,

ein Ansatz,

Option Explicit

Sub Filtern()
Dim Zei As Long, colC As New Collection, C As Long
On Error Resume Next
Call Loesch
With Worksheets("KW30")
  .Range("A4:K4").Copy .Range("M1")
  Zei = .Range("A4").End(xlDown).Row
  For C = 5 To Zei
    colC.Add Item:=CStr(.Cells(C, 7).Value), key:=CStr(.Cells(C, 7).Value)
  Next C
  On Error GoTo 0
  For C = 1 To colC.Count
    .Range("S2") = colC(C)
    Call csvTab(.Range("A4:K" & Zei), .Range("M1:S2"))
  Next C
  .Range("M1:S2").ClearContents
End With
End Sub

Sub csvTab(ByRef Liste As Range, ByRef Krit As Range)
Worksheets.Add after:=Worksheets(Worksheets.Count)
Liste.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Krit _
  , CopyToRange:=Range("A1"), Unique:=False
Rows(1).Delete
Columns("D:I").Delete
Columns("E").Delete
ActiveSheet.Name = "csvTab" & Krit.Cells(2, 7).Value
End Sub

Sub Loesch()
Dim wks As Worksheet
Application.DisplayAlerts = False
For Each wks In Worksheets
  If wks.Name Like "csvTab*" Then wks.Delete
Next wks
Application.DisplayAlerts = True
End Sub

Gruß
Reinhard


  

Betrifft: AW: Bitte um Hilfe bei csv-Export von: Tom Finnland
Geschrieben am: 28.07.2012 11:34:11

Hallo Reinhard,

zuerst einmal vielen Dank für deine Mühe, leider bekomme ich aber nicht das gewünschte Ergebniss, folgendes passiert wenn ich diesen Code anwende:
Call Loesch funktioniert, also ein bereits vorhandenes Blatt wird gelöscht, aber ansonst kann ich nicht feststellen das noch irgendwas kopiert wird. Ich sehe auch ein Problem mit "With Worksheets("KW30")"-das heisst nämlich jede Woche anders, aber das ist sicher eher das kleinere Problem. Tut mir leid das ich dir nur sehr laienhafte Rückmeldung geben kann, dein Code läuft ohne Fehlermeldung durch, es wird auch ein neues Blatt erstellt (csvtab3) aber eben nichts eingefügt??
lg thomas


  

Betrifft: Sorry, hatte was wichtiges vergessen von: Reinhard
Geschrieben am: 28.07.2012 15:45:15

Hallo Thomas,

ich habe den Code in deiner deiner hochgeladenen Mappe getestet.
Damit er funktioniert mußt du vorher manuell A1:K1 nach A4:K4 kopieren.
In Excel ist es grundsätzlich sehr schlecht zwischen Überschriftszeile und Datenzeilen Lücken zu
haben.

Teste das mal und dann können wir über die anderen Dinge reden falls er so funktioniert wie gewünscht.

Gruß
Reinhard


  

Betrifft: AW: Sorry, hatte was wichtiges vergessen von: Tom Finnland
Geschrieben am: 29.07.2012 11:23:00

Hallo Reinhard.
ja ich weiß die Tabelle ist sehr ungeschickt-kann das aber nicht ändern da die so vom Kunden kommt.
Manuell kopieren geht leider aus div. Gründen nicht-hab aber eine andere Möglichkeit gefunden-zur Erinnerung: Ich markiere im "Hauptblatt" einige Zeilen (genau die die ich halt jetzt grad brauche) - mit

Intersect(Selection, Union(Columns(1), Columns(2), Columns(3), Range("Suffix"), Range("Größe"))).Copy
Worksheets.Add after:=Worksheets(Worksheets.Count)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Name = "csvTab"

bekomme ich jetzt auch ein neues Blatt mit dem man vielleicht was anfangen kann.
Sieht so aus:

5411 Oberalm 1555 100 BETENN
5412 Puch bei Hallein 1665 100 BETENN
5424 Vigaun 731 100 BETENN

Folgende Probleme schaff ich aber wieder nicht:
Export geschieht mit falschem Trennzeichen - brauch unbedingt ";" -habs mit Local=True probiert aber trotzdem war das Trennzeichen ","

Pfad wo gespeichert werden soll ist ja fix-der Speicherame soll sich aber aus Spalte E + aktueller KW + "_"+Spalte D+.csv ergeben

Die Spalte D darf auch nicht mitexportiert werden-die hab ich nur mitkopiert weil ich nicht gewusst hab wie ich sonst an diesen Wert kommen könnte (schäm)....

also zusammenfassend-wenn ich aus obigen Tabellenblattinhalt eine CSV-Datei bekomme die so ausschaut:

5411;Oberalm;1555;BETENN
5412;Puch bei Hallein;1665;BETENN
5424;Vigaun;731;BETENN

und so heisst: BETENN32_100.csv
dann sind vorerst einmal meine Probleme gelöst:-))

Danke Dir nocchmal für deine Unterstützung und wünsche einen schönen Sonntag!!
lg Thomas