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 Leandra,

die Spalten werden einzeln, also nacheinander, eingelesen. Da sollte es keine Probleme geben.
Du kannst dir, wie ja beschrieben, beim Debuggen, die Variablen und Inhalte der Arrays anzeigen lassen. Dann kannst du ja nachsehen, wo der Fehler liegt.

Gruß

M.O.

Answer 2

Eine Letzte Frage habe ich noch

sollten Heute oder Morgen meine Daten zu gross werden und ich diese in eine Datenbank überspielen muss (Sql)
ist das Suchen über Exel so wie es in dieser Form ist Möglich.
Also quasi zugreifen auf DB und nach diesem Makro suchen
oder ist das eine komplett neue Geschichte.
Nur zur Info

Answer 3

Hallo Leandra,

von SQL habe ich überhaupt keine Ahnung, weiß aber, dass du da mit VBA nicht weiterkommst ;-). Such mal nach SQL Tutorial.

Gruß

M.O.

Answer 4

O.K
Hab ja jetzt das was ich suchte.

Klasse Arbeit !!!!!!

Vielen Dank noch mal

Answer 5

Hi M.O

Wirklich jetzt hab ich noch eine Frage
du schreibst
die Spalten werden einzeln, also nacheinander, eingelesen

könnte man nicht theoretisch 2 oder mehr Spalten einlesen und so noch schneller Suchen
oder geht das so nicht.

lg
Leandra

Answer 6

Hallo Leandra,

man könnte den ganzen Bereich in ein Array einlesen und dort die Spalten durchlaufen. Wie viel schneller das wäre, kann ich nicht sagen. Wie du im Code siehst, wird die Spalte ja in einem Rutsch in das Array eingelesen. Und je nach Größe der Datei / Anzahl der Daten ist das dann auch eine Frage des Arbeitsspeichers.

Gruß

M.O.

Answer 7

Hi
M.O

Wäre es viel Aufwand wenn du mir das so umbaust das er mir stets 5 Spalten als Array einliest und dann durchsucht
und dann die nächsten 5 usw.
Vielleicht kann ich mir das dann selber so zurechtrücken mal weniger mal mehr Spalten je nachdem wieviel er schafft.
Wäre gespannt ob das etwas an Geschwindigkeit bringen würde.
Wäre super wenn das ginge.
Ansonsten trotzdem Vielen Dank

lg
Leandra

Answer 8

Hallo Leandra,

hier das geänderte Makro.

Sub suchen2()

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
Dim lngEinleseS As Long
Dim lngDurchlauf As Long
Dim lngd 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

'Anzahl der Spalten festlegen, die pro Durchlauf eingelesen werden sollen
lngEinleseS = 5

'Anzahl der Durchläufe ermitteln
'Ganzzahl der Durchläufe ermitteln
lngDurchlauf = Int(lngSpalteL / lngEinleseS)
'Prüfen, ob Durchlauf ggf. um 1 erhöht werden muss
If lngSpalteL Mod lngEinleseS > 0 Then lngDurchlauf = lngDurchlauf + 1

'letzte Zeile ermitteln
lngLetzte = wksBlatt1.Cells.SpecialCells(xlCellTypeLastCell).Row

'Schleife, um alle Spalten im Suchblatt zu durchlaufen
For lngd = 0 To lngDurchlauf - 1

With wksBlatt1
'Spalten in Array einlesen
varSpalte = .Range(.Cells(1, 1 + lngd * lngEinleseS), .Cells(lngLetzte, lngEinleseS + lngEinleseS * lngd))
End With

'Vergleich
For lngSpalte = LBound(varSpalte, 2) To UBound(varSpalte, 2)
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, lngSpalte) = 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 + lngEinleseS * lngd).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 + lngEinleseS * lngd) = varSpalte(e, 1)
lngZeile = lngZeile + 1
Next e
End With

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

Next a

Next lngSpalte
Next lngd

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

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Die Anzahl der Spalten, die in das Array eingelesen werden sollen, kannst du über die Variable lngEinleseS festlegen.

Gruß

M.O.

Answer 9

Hi
M.O

Klasse Arbeit es läuft super schnell durch
Ich habe mir für das vorherige Makro eine Statusbaranzeige gemacht
'Meldung in Statusbar schreiben, welche Spalte durchsucht wird
Application.StatusBar = "Spalte " & lngSpalte & " von " & lngSpalteL & " wird durchsucht "
aber was muss ich für dieses Makro ändern damit die Statusbar läuft?

Answer 10

Hallo Leandra,

freut mich, dass das Makro so funktioniert, wie du es willst.

Für die Meldung im Statusbar musst du das Makro wie folgt ergänzen:

'Vergleich
For lngSpalte = LBound(varSpalte, 2) To UBound(varSpalte, 2)
'Statusmeldung
Application.StatusBar = "Spalte " & lngSpalte + lngd * lngEinleseS & " von " & lngSpalteL & " wird durchsucht "

und füge am Ende noch

Application.StatusBar = False

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

ein, damit der Statusbar wieder zurückgesetzt wird.

Gruß

M.O.