Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Frage Microsoft Microsoft Office

Große CSV-Daten in kleine Stückeln per Makro

Mitglied: scax2012

scax2012 (Level 1) - Jetzt verbinden

20.03.2012, aktualisiert 16:11 Uhr, 2108 Aufrufe, 1 Kommentar

Hallo,

ich habe mit größeren Excel-CSV Daten zu kämpfen. Meine Files haben meist über 1 Mio Datenzeilen, somit von Excel nicht zu verarbeiten.

Über das folgende Makro, hat man es geschafft, die Datei einzulesen und auf eine X-Zeilenanzahl und mehreren Tabellen zu verteilen.

Ich habe jetzt NUR 2 Probleme noch, ich möchte....

1.) Angeben können, wieviele Header-Zeilen immer je Tabellenblatt oben vorweg eingefügt werden (brauche den Kopf der Quelldatei).
2.) am Schluß, alle Tabellenblätter auf einzelne CSV-Dateien exportieren (Makro gefunden, nur wie einbinden?).



Hier mal der Code, hier fehlt noch der Befehl, dass X-Zeilen vom Kopf je Tabellenblatt eingefügt werden am Anfang:

01.
Option Explicit 
02.
Option Base 1 
03.
Sub LargeFileImport() 
04.
Dim FileName        As String 
05.
Dim FileNum         As Integer 
06.
Dim ResultStr       As String 
07.
Dim wsSheet         As Worksheet 
08.
Dim strValues()     As String 
09.
Dim lngRows         As Long 
10.
Dim lngRow          As Long 
11.
Dim intSheet        As Integer 
12.
Dim Eingabe         As String 
13.
Dim SollRows        As String 
14.
Dim NeuRows         As String 
15.
Dim CopyRows        As String 
16.
Dim InsertRows      As String 
17.
 
18.
 
19.
'************************************************************************************* 
20.
' Abfrage von maximalen Datenzeilen je Tabellenblatt 
21.
'************************************************************************************* 
22.
    SollRows = InputBox("Bitte geben Sie die maximale Zeilenanzahl ein:", "Maximale Zeilenanzahl") 
23.
    If SollRows = "" Then Exit Sub 
24.
        If IsNumeric(SollRows) Then 
25.
            NeuRows = SollRows 
26.
        Else 
27.
            If MsgBox("Sie haben keine Zahl eingeben!", vbOKOnly, "Maximale Zeilenanzahl") = vbOK Then 
28.
            Exit Sub 
29.
        End If 
30.
    End If 
31.
     
32.
    If MsgBox("Sie haben eine maximale Zeilenanzahl angegeben von: " & NeuRows, vbOKCancel, "Maximale Zeilenanzahl") = vbCancel Then 
33.
        Exit Sub 
34.
    End If 
35.
 
36.
'************************************************************************************* 
37.
' Abfrage wieviele Datenzeilen als Header an Tabellenblatt-Anfang kopiert werden sollen 
38.
'************************************************************************************* 
39.
    CopyRows = InputBox("Bitte geben Sie die Zeilenanzahl für den zu kopierenden Spaltenkopf ein:", "Zeilenanzahl für Spaltenkopf") 
40.
    If CopyRows = "" Then Exit Sub 
41.
        If IsNumeric(CopyRows) Then 
42.
            InsertRows = CopyRows 
43.
        Else 
44.
            If MsgBox("Sie haben keine Zahl eingeben!", vbOKOnly, "Zeilenanzahl für Spaltenkopf") = vbOK Then 
45.
            Exit Sub 
46.
        End If 
47.
    End If 
48.
 
49.
    If MsgBox("Sie haben eine Zeilenanzahl für den zu kopierenden Spaltenkopf angegeben von: " & NeuRows, vbOKCancel, "Zeilenanzahl für Spaltenkopf") = vbCancel Then 
50.
        Exit Sub 
51.
    End If 
52.
'************************************************************************************* 
53.
' Ende aller Abfragen 
54.
'************************************************************************************* 
55.
 
56.
   FileName = Application.GetOpenFilename("Textdateien " & _ 
57.
                  "(*.txt; *.csv;*.asc),*.txt; *.csv; *.asc") 
58.
 
59.
   If FileName = "" Or FileName = "Falsch" Then Exit Sub 
60.
   FileNum = FreeFile() 
61.
    
62.
   On Error GoTo ErrorHandler 
63.
   Open FileName For Input As #FileNum 
64.
   Application.ScreenUpdating = False 
65.
   Workbooks.Add template:=xlWorksheet 
66.
 
67.
   lngRows = NeuRows 
68.
   lngRow = 1 
69.
   intSheet = 1 
70.
   ReDim strValues(lngRows, 1) 
71.
 
72.
   Application.StatusBar = " Einlesen Blatt " & intSheet & " / 0 %" 
73.
 
74.
   Do While Seek(FileNum) <= LOF(FileNum) 
75.
      Line Input #FileNum, ResultStr 
76.
      If Left(ResultStr, 1) = "=" Then 
77.
         strValues(lngRow, 1) = "'" & ResultStr 
78.
      Else 
79.
         strValues(lngRow, 1) = ResultStr 
80.
      End If 
81.
      If lngRow < lngRows Then 
82.
         lngRow = lngRow + 1 
83.
         If (lngRow * 100 / lngRows) Mod 10 = 0 Then 
84.
            Application.StatusBar = " Einlesen Blatt " & intSheet & _ 
85.
                                    " / " & Int(lngRow * 100 / lngRows) & " %" 
86.
         End If 
87.
      Else 
88.
         Application.StatusBar = " Schreibe Daten in Blatt " & intSheet 
89.
         ActiveSheet.Range("A1:A" & lngRows) = strValues 
90.
         ActiveWorkbook.Worksheets.Add after:=Worksheets(Worksheets.Count) 
91.
 
92.
         ReDim strValues(lngRows, 1) 
93.
         lngRow = 1 
94.
         intSheet = intSheet + 1 
95.
         Application.StatusBar = "Einlesen Blatt " & intSheet 
96.
      End If 
97.
   Loop 
98.
   Close 
99.
   ActiveSheet.Range("A1:A" & lngRows) = strValues 
100.
    
101.
'************************************************************************************* 
102.
' Beginn der Aufteilung in Spalten 
103.
'************************************************************************************* 
104.
   Dim strDelimiter As String 
105.
   Do 
106.
      strDelimiter = Application.InputBox("1  ==>    Tabulator " & Chr(13) & _ 
107.
                                          "2  ==>    Semikolon" & Chr(13) & _ 
108.
                                          "3  ==>    Komma" & Chr(13) & _ 
109.
                                          "4  ==>    Leerzeichen" & Chr(13) & _ 
110.
                                          "5  ==>    Andere" & Chr(13) & _ 
111.
                                          "Trennzeichen wählen", "1", Type:=1) 
112.
   Loop Until CInt(strDelimiter) >= 0 And CInt(strDelimiter) <= 5 
113.
 
114.
   If strDelimiter = 5 Then 
115.
      Dim strDelimOther As String 
116.
      strDelimOther = Application.InputBox("Bitte das verwendete Trennzeichen " _ 
117.
                                           & "eingeben" & Chr(13) & _ 
118.
                                           "00 ==> Abbruch ", _ 
119.
                                           "Trennzeichen wählen", Type:=2) 
120.
      If strDelimOther = "00" Then GoTo ErrorHandler 
121.
   End If 
122.
 
123.
   intSheet = 0 
124.
   For Each wsSheet In ActiveWorkbook.Worksheets 
125.
      intSheet = intSheet + 1 
126.
      Application.StatusBar = "Bearbeiten von Blatt " & intSheet 
127.
      With wsSheet 
128.
         .Range("A:A").TextToColumns Destination:=.Range("A1"), _ 
129.
                                     DataType:=xlDelimited, _ 
130.
                                     TextQualifier:=xlDoubleQuote, _ 
131.
                                     ConsecutiveDelimiter:=False, _ 
132.
                                     Tab:=IIf(strDelimiter = "1", True, False), _ 
133.
                                     Semicolon:=IIf(strDelimiter = "2", True, False), _ 
134.
                                     Comma:=IIf(strDelimiter = "3", True, False), _ 
135.
                                     Space:=IIf(strDelimiter = "4", True, False), _ 
136.
                                     Other:=IIf(strDelimiter = "5", True, False), _ 
137.
                                     OtherChar:=IIf(strDelimiter = "5", strDelimOther, "") 
138.
      End With 
139.
   Next wsSheet 
140.
ErrorHandler: 
141.
   Application.ScreenUpdating = True 
142.
   Application.StatusBar = "Fertig" 
143.
End Sub





Hier das Makro, das eingebunden werden muss, damit automatisch auch gestückelt / exportiert wird:

01.
Sub splitten_als_csv()  
02.
	Dim I_Sheets As Integer  
03.
	Dim F_Name As String  
04.
	Dim F_Path As String  
05.
 
06.
	F_Path = Application.InputBox("Pfad angeben")  
07.
 
08.
	For I_Sheets = 1 To Sheets.Count  
09.
	F_Name = F_Path + Sheets(I_Sheets).Name + ".csv"  
10.
 
11.
	Sheets(I_Sheets).SaveAs Filename:=F_Name, FileFormat:= _  
12.
	xlCSV, CreateBackup:=False  
13.
 
14.
	Next I_Sheets  
15.
End Sub

VIELEN Dank im voraus!
Mitglied: mak-xxl
20.03.2012 um 17:12 Uhr
Moin scax2012,

wenn ich das Ganze richtig verstanden habe, so soll auf jedem Blatt der gleiche Kopf stehen, dessen Zeilenzahl am Anfang abgefragt wird?
Wenn ja, dann evtl. so:
- Blatt 1 (nur?) mit Kopf füllen, für alle anderen Blätter:
- In Zeile 68: lngRow = InsertRows + 1
- In Zeile 90: Sheets(1).Range("A1:IV" & InsertRows) kopieren nach Sheets(xx).Range("A1:IV" & InsertRows)

Das Einlesen neuer Werte dann ab Zeile InsertRows +1.

Das Exportmakro kannst Du doch extra stehenlassen und per 'Call splitten_als_csv' aus dem ersten Makro rufen.

[Edit] Wäre es eine Option, die originale csv-Datei in der Befehlszeile in Excel-gerechte Happen zu zerlegen (65536 oder ab xl2007 in 1.048.576 Zeilen) [/Edit]

Freundliche Grüße von der Insel - Mario
Bitte warten ..
Ähnliche Inhalte
Batch & Shell
CSV kleinerer Wert (Batch)
Frage von jochengBatch & Shell3 Kommentare

Ich habe eine CSV Datei mit folgendem Inhalt: 29664;24,95 29664;12,95 29645;9,95 29645;9,95 29655;12,95 29655;24,95 29664;24,95 29655,12,95 29655,24,95 29664;12,95 29664;24,95 ...

Linux Tools
CSV-Daten zurechtbauen in ein Skript
gelöst Frage von Jens4everLinux Tools2 Kommentare

Moin zusammen, ich habe eine Datei "Datei", die so aufgebaut ist: (Geburtstag; Name; E-Mailadresse) Mit grep ziehe ich aus ...

Batch & Shell
CSV Stapelverarbeitung mit Filterfunktion für große Datenmengen
Frage von RippchenBatch & Shell8 Kommentare

Hallo, Ich studiere und muss in einer Projektarbeit Daten auswerten, die mir leider nur in vielen (über 100000) csv ...

Windows Netzwerk
Größe des Netzlaufwerkes wird kleiner angezeigt als es tatsächlich ist
Frage von EDV-OellerkingWindows Netzwerk3 Kommentare

Hallo zusammen, wir haben auf einem PC das Problem, dass die verbundenen Netzlaufwerke eine falsche Größe anzeigen. Das Netzlaufwerk ...

Neue Wissensbeiträge
Tipps & Tricks

Solutio Charly Updater Fehlermeldung: Das Abgleichen der Dateien in -Pfad- mit dem Datenobject ist fehlgeschlagen

Tipp von StefanKittel vor 11 StundenTipps & Tricks

Hallo, hier einmal als Tipp für alle unter Euch die mit der Zahnarztabrechnungssoftware Charly von Solutio zu tun haben. ...

Sicherheit

Meltdown und Spectre: Wir brauchen eine "Abwrackprämie", die die CPU-Hersteller bezahlen

Information von Frank vor 11 StundenSicherheit7 Kommentare

Zum aktuellen Thema Meltdown und Spectre: Ich wünsche mir von den CPU-Herstellern wie Intel, AMD oder ARM eine Art ...

Sicherheit

Meltdown und Spectre: Realitätscheck

Information von Frank vor 12 StundenSicherheit8 Kommentare

Die unangenehme Realität Der Prozessorfehler mit seinen Varianten Meltdown und Spectre ist seit Juni 2017 bekannt. Trotzdem sind immer ...

Sicherheit

Meltdown und Spectre: Die machen uns alle was vor

Information von Frank vor 12 StundenSicherheit12 Kommentare

Aktuell sieht es in den Medien so aus, als hätten die Hersteller wie Intel, Microsoft und Co den aktuellen ...

Heiß diskutierte Inhalte
Windows 10
Netbook erkennt Soundkarte nicht - keinerlei Info zum Hersteller und Modell vom Netbook und Hardware bekannt
Frage von 92943Windows 1031 Kommentare

Guten Tag, meine Schwester reist in einigen Wochen für ein paar Monate ins Ausland und hat sich dafür ein ...

Batch & Shell
Anmeldevorgang für Informatikraum (Schule) unter Windows
gelöst Frage von IngenieursBatch & Shell29 Kommentare

Hey zusammen, ich werde in naher Zukunft den Informatik Raum meiner jetzigen Schule von dem aktuellen Betreiber übernehmen (Vertrag ...

Netzwerkgrundlagen
Welches Modem für VDSL 50000 der T-Com
Frage von Windows10GegnerNetzwerkgrundlagen20 Kommentare

Hallo, ein Kollege von mir will sich VDSL50000 von der T-Com holen, um daran einen Server zu betreiben. Ich ...

Batch & Shell
AD-Abfrage in Batchdatei und Ergebnis als Variable verarbeiten
gelöst Frage von Winfried-HHBatch & Shell19 Kommentare

Hallo in die Runde! Ich habe eine Ergänzungsfrage zu einem alten Thread von mir. Ausgangslage ist die Batchdatei, die ...