Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

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

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

Frage Microsoft Microsoft Office

Mitglied: scax2012

scax2012 (Level 1) - Jetzt verbinden

20.03.2012, aktualisiert 16:11 Uhr, 2074 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 ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
Batch & Shell
CSV Stapelverarbeitung mit Filterfunktion für große Datenmengen (4)

Frage von Rippchen zum Thema Batch & Shell ...

VB for Applications
Bestimmte Daten aus eine CSV-Datei in eine Excel-Tabelle importieren (2)

Frage von MariaElena zum Thema VB for Applications ...

Microsoft Office
gelöst CSV-Datei mit einem VBA Makro in Excel einlesen und leicht anpassen (5)

Frage von JoSiBa zum Thema Microsoft Office ...

Heiß diskutierte Inhalte
Router & Routing
gelöst Ipv4 mieten (22)

Frage von homermg zum Thema Router & Routing ...

Windows Server
DHCP Server switchen (20)

Frage von M.Marz zum Thema Windows Server ...

Exchange Server
gelöst Exchange 2010 Berechtigungen wiederherstellen (20)

Frage von semperf1delis zum Thema Exchange Server ...

Hardware
gelöst Negative Erfahrungen LAN-Karten (19)

Frage von MegaGiga zum Thema Hardware ...