Excel Makro für csv Export

Question

Hi Leute

Hab hier ein Makro für csv Export aus dem Netz

Sub CSVTab()

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

strMappenpfad = ActiveWorkbook.FullName
strMappenpfad = Replace(strMappenpfad, ".xls", ".csv")

strDateiname = InputBox("Wie soll die CSV-Datei heißen (c:\test.csv)?", "CSV-Export", strMappenpfad)
If strDateiname = "" Then Exit Sub

strTrennzeichen = InputBox("Welches Trennzeichen soll verwendet werden?", "CSV-Export", ",")

'# GEAENDERT
'# Wenn kein Trennzeichen eingegeben wird (Wichtig: mit "Entf" löschen!), findet TAB (vbTab) Verwendung
If strTrennzeichen = "" Then
strTrennzeichen = vbTab
' Exit Sub ' muss natürlich raus. Er soll ja weitermachen.
End If
'# GEAENDERT

Set Bereich = ActiveSheet.UsedRange

Open strDateiname For Output As #1

For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
strTemp = strTemp & """" & CStr(Zelle.Text) & """" & strTrennzeichen
Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1)
Print #1, strTemp
strTemp = ""
Next

Close #1
Set Bereich = Nothing
MsgBox "Export erfolgreich. Datei wurde exportiert nach" & vbCrLf & strDateiname

End Sub


aber irgendwie funktioniert es nicht wie ich es brauche.
Benötige Csv Export als Tab aber er macht mir stets "" anstatt TAB
zwischen den Zahlen.

Kann mir vielleicht jemand Helfen von den Spezies hier

Answer 1

Hallo,

wenn du bei der Abfrage des Trennzeichens mit ENTF den Inhalt der Input-Box entfernst und dann bestätigst, wird als Trennzeichen Tab genommen. Das funktioniert so weit auch, nur werden die einzelnen Zellinhalte in Anführungszeichen gesetzt. Ich nehme mal an, dass du diese meinst.

Die Anführungszeichen werden hier im Code durch die Zeile
[code]strTemp = strTemp & """" & CStr(Zelle.Text) & """" & strTrennzeichen[/code]
eingefügt.
Ersetze diese Zeile durch:
[code]strTemp = strTemp & CStr(Zelle.Text) & strTrennzeichen[/code]

Da du ja nur das TAB-Trennzeichen willst, kannst du dir die Abfrage auch sparen:

[code]Sub CSVTab2()

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

strMappenpfad = ActiveWorkbook.FullName
strMappenpfad = Left(strMappenpfad, InStrRev(strMappenpfad, ".")) & "csv"

strDateiname = InputBox("Wie soll die CSV-Datei heißen (c:\test.csv)?", "CSV-Export", strMappenpfad)
If strDateiname = "" Then Exit Sub

strTrennzeichen = vbTab

Set Bereich = ActiveSheet.UsedRange

Open strDateiname For Output As #1

For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
strTemp = strTemp & CStr(Zelle.Text) & strTrennzeichen

Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1)
Print #1, strTemp
strTemp = ""
Next

Close #1
Set Bereich = Nothing
MsgBox "Export erfolgreich. Datei wurde exportiert nach" & vbCrLf & strDateiname

End Sub[/code]

Ich habe auch die Ermittlung des Dateinamens angepasst, damit der Code auch mit xlsx- und .xlsm-Mappen arbeitet.

Gruß

M.O.

Answer 2

Hallo M.O

Ich danke dir du hast mein 1.Problem gelöst.
Ich habe schon von dir gehört (nur gutes)vielleicht kannst du mir bei meinem 2. Problem helfen.
Ich habe mir im Excel quasi eine kleine Datenbank erstellt alles Artikelnummer jetzt müsste ich auch diese Suchen und finden.
Sind mehrere Spalten mit mehr als 300.00 Artikelnummern.
Da die Datenbank immer grösser wird sollte das auch so schnell wie Möglich ablaufen.
Jetzt möchte ich die Datei als csv speichern und suche dann in dieser Datei mittels INSTR() nach den Suchbegriffen.
Die Suchzellen werden in ein Array von Tabelle1 übertragen sind meist 4-7 Zeilen

z.b so

14569
15905
13951
....

Dann sollen alle Spalten nach diesen Artikelnummern aber nur in dieser Reihenfolge mittels INSTR() gesucht
und bei Treffer in neues Tabellenblatt kopiert werden.
Es kann aber auch sein das diese in den andere Spalten auch so vorkommen und deswegen sollten die 2-3 Artikelnummer
davor als auch danach mit ins neue Tabellenblatt kopiert werden.
Denn diese werden dann unseren Kunden zur Abnahme zugeschickt.Ist ein wenig kompliziert ist aber so.


oder eine andere Möglichkeit wäre
Keine csv Datei machen
und mehrere Blöcke aus der Tabelle (1-2 Spalten) nacheinander in EIN Array schreiben und dieses dann sehr schnell mit VBA durchsuchen!


Es kommt mir auf die Geschwindigkeit an
Kannst du mir das vielleicht so umsetzten.

Wäre echt Klasse

Answer 3

Hallo Leandra,

warum willst du die Artikelnummern mit INSTR suchen? Stehen diese in den Spalten in einem Text? Falls nur die Artikelnummern in einer Zelle stehen,dann reicht auch eine einfache Suche,
Das Suchen nach einer Zahlenfolge hatten wir hier schon einmal: KLICK MICH!

Am besten erklärst du mal genau den Aufbau deiner Datei. Sind alle Spalten mit Artikelnummern gefüllt oder nur bestimmte Spalten, d.h. müssen alle Spalten durchsucht werden, oder nur z.B. jede zweite Spalte?

Vielleicht könntest du auch eine kleine Beispieldatei, die deiner Orginaldatei im Aufbau gleicht, auf einen Hoster deiner Wahl hochladen und den Link dann hier posten.

Gruß

M.O.

Answer 4

Hi
M.O

Hab mir das Makro angeschaut zu 90% genau das was ich suche nur
gäbe es eine schneller Such/Vergleich Methode.

Da die Suchzahlen in ein Array geschrieben sind
würde ich gerne auch 1 oder 2 ganze Spalten in ein Array schreiben und
dann diese mit den gesuchten Zahlen/Werten vergleichen.
Ich weiss nicht wieviel Spalten kann man in ein Array packen wenn diese bis zur Gänze
gefüllt werden? (Es gibt glaube ich ein Limit)
DIes sollte die Geschwindigkeit der Suche wesentlich erhöhen

Das Makro könnte dann so aussehen.

Suchzahlen in Array schreiben
Spalte(n) mit Artikelnummer in Array schreiben
Vergleichen
Bei Treffer in neue Tabelle kopieren wie bei diesem Makro (gefällt mir Ganz gut)
und wieder von Vorne nächste Spalten in Array schreiben -- vergleichen - Treffer kopieren

usw....

Bin leider kein Programmierer kannst du mir das Bitte so umsetzen.
Das wäre ganz Toll

Answer 5

Hallo Leandra,

die Suche per Array ist machbar. Jedoch wäre es - siehe meine Antwort 3 - gut, wenn du mal genau den Aufbau der Tabelle darstellen würdest oder eine entsprechende Beispieldatei auf einem Hoster deiner Wahl hochlädst und den Link hier postest.

Zur Geschwindigkeit: Wie du in dem verlinkten Thread gelesen hast, war die Geschwindigkeit ausreichend, bei einer großen Datei. Du kannst das Makro ja mal in einer Testdatei ausprobieren ;-).

Gruß

M.O.

Answer 6

Hi M.O
hier dein Link
http://www.filehosting.at/file/details/602511/Artikelnummersuche.xlsx

Wie gesagt ist angelegt an das Makro oben kommt zu 90% hin
aber wegen der Geschwindigkeit als Array besser bzw. schnellerere Suche.

Den wenn die Datenbank größer wird wird die Geschwindigkeit ein Faktor.

Vielen Dank für dein Bemühen

lg
Leandra

Answer 7

Hallo Leandra,

das folgende Makro gehört in ein allgemeines Modul deiner Arbeitsmappe:

Sub suchen()

Dim wksBlatt1 As Worksheet
Dim wksBlatt2 As Worksheet
Dim wksBlatt3 As Worksheet
Dim lngLetzte As Long
Dim lngLetzte3 As Long
Dim lngSpalte As Long
Dim lngSpalteL As Long
Dim varSuchen As Variant
Dim varSpalte As Variant
Dim lngZaehler As Long
Dim s As Long
Dim a As Long
Dim e As Long
Dim lngAnfang As Long
Dim lngEnde As Long
Dim lngFarbe As Long
Dim lngZeile As Long

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Arbeitsblätter festlegen
Set wksBlatt1 = ThisWorkbook.Worksheets("Artikelnummern") 'Tabelle, die durchsucht werden soll
Set wksBlatt2 = ThisWorkbook.Worksheets("Suchartikel") 'Tabelle mit den zu suchenden Zahlen
Set wksBlatt3 = ThisWorkbook.Worksheets("Ergebnis") 'Tabelle in die die Suchergebnisse einfügt werden

'Suchzahlen aus Arbeitsblatt Suchartikel in Array einlesen
'dazu die letzte Zeile im Arbeitsblatt in Spalte A ermitteln
With wksBlatt2
lngLetzte = .Cells(Rows.Count, 1).End(xlUp).Row
'nun ab A1 die Daten in das Sucharray einlesen
varSuchen = .Range(.Cells(1, 1), .Cells(lngLetzte, 1))
End With

'in Zieltabelle für Suchergebnisse ggf. vorhandene Daten löschen
wksBlatt3.Cells.Clear

'Im Suchblatt letzte Spalte ermitteln
lngSpalteL = wksBlatt1.Cells(1, Columns.Count).End(xlToLeft).Column

'Schleife, um alle Spalten im Suchblatt zu durchlaufen
For lngSpalte = 1 To lngSpalteL
'letzte beschriebene Zeile für Spalte ermitteln
With wksBlatt1
lngLetzte = .Cells(Rows.Count, lngSpalte).End(xlUp).Row
'Spalte in Array einlesen
varSpalte = .Range(.Cells(1, lngSpalte), .Cells(lngLetzte, lngSpalte))
End With

'Vergleich
For a = LBound(varSpalte, 1) To UBound(varSpalte, 1)
'Zaehler auf Null setzen
lngZaehler = 0
For s = LBound(varSuchen, 1) To UBound(varSuchen, 1)
If varSpalte(a + s - 1, 1) = varSuchen(s, 1) Then
lngZaehler = lngZaehler + 1
Else
Exit For
End If
Next s

'Falls Übereinstimmung,
If lngZaehler = UBound(varSuchen, 1) Then

'dann Anfang und Ende des einzufügenden Bereichs festlegen
lngAnfang = a - 2
lngEnde = a + UBound(varSuchen, 1) + 2
'Anfang und Ende prüfen, ob diese im zulässigen Bereich liegen
If lngAnfang < 1 Then lngAnfang = 1
If lngEnde > UBound(varSpalte, 1) Then lngEnde = UBound(varSpalte, 1)
'Zeile für das Einfärben der gefundenen Übereinstimmungen ermitteln
lngFarbe = a - lngAnfang

'letzte Zeile in Einfügespalte = Suchspalte ermitteln
lngLetzte3 = wksBlatt3.Cells(Rows.Count, lngSpalte).End(xlUp).Row + 2
'Einfügezeile ggf. korrigieren
If lngLetzte3 = 3 Then lngLetzte3 = 1
'Inhalte einfügen
With wksBlatt3
'Zähler für Einfügezeile auf Null setzen
lngZeile = 0
For e = lngAnfang To lngEnde
.Cells(lngLetzte3 + lngZeile, lngSpalte) = varSpalte(e, 1)
lngZeile = lngZeile + 1
Next e
End With

'Suchzahlen in gefundener Reihe einfärben
With wksBlatt3
.Range(.Cells(lngLetzte3 + lngFarbe, lngSpalte), .Cells(lngLetzte3 + lngFarbe + UBound(varSuchen, 1) - 1, lngSpalte)).Interior.Color = vbYellow
End With
End If

Next a

Next lngSpalte

'Auf Blatt 3 mit den gefundenen Daten wechseln
With wksBlatt3
.Activate
.Range("A1").Select
End With

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Die zu suchenden Zahlen müssen in das Arbeitsblatt "Suchartikel" untereinander in Spalte A eingegeben werden. Die gefundenen Zahlenreihen werden im Blatt "Ergebnis" in der Spalte ausgegeben, in der sie im Arbeitsblatt "Artikelnummern" gefunden wurden.
Das Tabellenblatt "Ergebnis" wird vor jedem Suchlauf gelöscht. Die Suchartikel sind farblich hervorgehoben.

Gruß

M.O.

Answer 8

Hi
M.O

erstmal Danke fürs Makro ist sehr schnell
nur bekomme ich eine Fehlermeldung
Laufzeitfehler 9 Index außerhalb des gültigen Bereichs- im Debug Modus
wurde das Gelb markiert If varSpalte(a + s - 1, 1) = varSuchen(s, 1) Then
was besagt diese Fehlermeldung?

Answer 9

Hallo Leandra,

bei meinen Tests in deiner Beispieldatei funktioniert das Makro ohne Probleme.
Die Fehlermeldung besagt hier, dass auf ein Element im Feld zugegriffen werden soll, das es jedoch nicht gibt
Kommt die Fehlermeldung am Anfang oder am Ende des Makros? Wenn die Fehlermeldung kommt, dann klicke auf Debuggen. Wenn du dann mit dem Cursor über die einzelnen Variablen fährst, kannst du deren Wert sehen.
Eine Ferndiagnose ohne die entsprechende Datei ist immer schwierig.

Gruß

M.O.

Answer 10

Hi
M.O

Hab die Fehlermeldung ziemlich am Ende der Datei liegt bestimmt nicht an deinem Makro.
Ist super schnell. Bin begeistert und dankbar für deine Hilfe.
Eine Frage die Spalten werden ja in Array eingeschrieben gibt es da ein Limit an Spalten
die eingelesen werden können.
Ist das eine Speicherfrage die mit der Zeit zum Problem werden könnte?

lg
Leandra