jrlohni
Goto Top

VBS-Makro: Daten aus geschlossener ".csv" analysieren und kopieren

Moin zusammen,

ich "kämpfe" seit einigen Tagen mit Excel Makros.
Ich habe mir aus diversen Quellen ein Makro zusammengebaut welches häufig funktioniert, aber leider nicht immer.

Folgendes Szenario:
Ich habe eine Excel Liste, welche mir Daten zu einem String zusammenbaut, damit ein Programm diese lesen kann. Diese Excel würde ich gerne mit Daten aus unterschiedlichsten .csv Dateien (zu 99% zumindest eine .csv Datei) füllen. Gefüllt werden nur Spalte A und C. A mit dem Datum, welches auch in den .csv vorhanden ist und C mit den weiteren Daten aus der .csv. Diese können allerdings auch immer mal in anderen Spalten stehen und auch in anderen Zeilen anfangen.

Das Datum füllen habe ich aktuell so gelöst, dass dieses händisch durch eine Abfrage eingegeben wird und dann entsprechend gefüllt wird. Die Dateneingabe habe ich aktuell so gelöst, dass die Datei vor dem Ausführen des Makros geöffnet werden muss und dann der Dateiname, Tabellenblattname (aktuell auskommentiert, da er dem Dateinamen ohne Endung gleicht) und die erste Zelle (in Spalte und Zeile getrennt) eingegeben werden muss. Das hat bisher auch einigermaßen funktioniert, manchmal sagt er aber das der Index out of Range ist... Wenn ich dann die Variablen Dateiname und Tabellenblatt sowie erste Zelle manuell im Makro festsetze, klappt es oft.
Noch dazu läuft das ganze Makro ewig, da es sich um 36000 Zeilen handelt. Vielleicht bekommt man das schneller hin?

Da würde ich gerne einmal wissen ob es eine bessere Lösung gäbe. Gerne würde ich einfach die Datei auswählen, welche genutzt werden soll. Dort soll automatisch nach dem Datumsbereich geschaut werden und eventuell sogar automatisch die Zelle mit den Daten ausgewählt werden. Allerdings können die Daten mal in B3 mal in C3 und sicher auch mal in F3 oder F2 starten. Die anderen Zellen sind NICHT IMMER Leer!... - Also ist eine händische Eingabe vielleicht gar nicht schlecht.


Im zweiten Schritt möchte ich gerne Spalte von Spalte "F" ab Zelle F3 jeden 4. Wert in eine extra .csv wieder speichern, solange der Wert keinen Fehler aufweist. Es muss hinter dem letzten Komma eine 0 oder ein anderer Wert stehen. Wichtig dabei ist, dass die Datei einen Namen zugewiesen bekommt. Dieser muss nämlich entsprechende Bedingungen erfüllen, dass die Datei von dem Programm aus dem 1. Abschnitt zugeordnet werden kann. Das ganze funktioniert aber schon "ganz gut". Dort wäre eventuell die Auswahl eines Dateispeicherpfades noch nett. Ansonsten muss man den Manuell im Makro eintragen (so ist es aktuell)

Da die Dateien mit den Makros beide auf diversesten Rechnen und mit den unterschiedlichsten Dateien genutzt werden, muss es leider möglichst individuell und von Laien nutzbar sein.

Beide Makros werden aktuell über einen Button in der Excel gestartet.
Beide Makros müssen nicht jedes mal bis Zeile 36000 laufen. Allerdings müssen sie Überprüfen ob in der Quelldatei in der Zeile noch Daten vorhanden sind und diese dann kopieren. Grundsätzlich korreliert das Datum mit der Anzahl der Werte (96 Werte pro Tag, alle 15 min ein Wert). Allerdings muss dann die Datumseingabe immer zu 100% richtig erfolgen, damit auch alle Werte übernommen werden. Daher hatte ich es erstmal so gelöst das alle Werte bis 36000 Kopiert werden (etwas mehr als ein Jahr).

Ich habe euch die Codes der beiden Makros und Fotos der Excel und .csv Daten hier mal angehangen. Ich kann leider keine Daten anhängen, sonst würde ich euch die zur Verfügung stellen.

Datei welche geöffnet wird und die Makros enthält heißt: Konvertierung_Lastgangdaten_Enercast.xlsm
Datei welche in diesem Beispiel geöffnet werden sollte zum Datenimport heißt: Beckum-Vellern_2015.csv
Zieldatei mit den Daten aus Spalte F ab F3 müsste heißen: WEA Beckum-Vellern 2.csv


Importieren der Daten:
Sub BefuelleSpalteA()

Dim Z As Long
Dim d As Long
Dim m As Long
'Zeilen Offset festlegen  
Dim o As Long
o = 2
Dim diff As Long

Dim Spalte As String
Dim ersteZeile As Long
Dim blattName As String
Dim dateiName As String

MsgBox "Bitte den zu konvertierenden Lastgang šffnen und anschlie§end mit <OK> bestŠtigen! Anschlie§end die weiteren Eingaben tŠtigen.", vbInformation, "Hinweis"  

'Datumseingabe  
Anfangsdatum = InputBox("Bitte Anfangsdatum des Lastgangs eingeben!", "Eingabe") 'Range("C1").Value  
Enddatum = InputBox("Bitte Enddatum des Lastgangs eingeben!", "Eingabe") 'Range("E1").Value  

'Eingabe der Anfangszelle der Leistungen in den LastgŠngen  
dateiName = InputBox("Bitte Datei-Namen der Lastgangdaten Eingeben", "Eingabe")  
Spalte = InputBox("Bitte Spalte der ersten Daten Eingeben", "Eingabe") 'Range("G1").Value  
ersteZeile = InputBox("Bitte Zeile der ersten Daten Eingeben", "Eingabe") 'Range("I1").Value  
'blattName = InputBox("Bitte Tabellenblatt-Namen der Lastgangdaten Eingeben", "Eingabe") 'Range("K1").Value  



diff = DateDiff("d", Anfangsdatum, Enddatum) + 1  
m = o

Range("A1").ClearContents  
Range("A3:A36000").ClearContents  
Rows(1).Interior.Color = xlNone

If Anfangsdatum > Enddatum Then
Cells(1, 1).Value = "FEHLER!"  
Rows(1).Interior.Color = vbRed
Else
Enddatum = DateAdd("d", 1, Enddatum)  
For Z = 1 To diff
    For d = 1 To 24 * 4
    m = m + 1
    Cells(m, 1).Value = Anfangsdatum
    Next d
    Anfangsdatum = DateAdd("d", 1, Anfangsdatum)  
Next Z
End If

Range("D3:D36000").ClearContents  

Workbooks(dateiName & ".csv").Worksheets(dateiName).Range(Spalte & ersteZeile, Spalte & 36000).Copy  
'Workbooks("Beckum-Vellern_2015.csv").Worksheets("Beckum-Vellern_2015").Range("B3:B36000").Copy  
Workbooks("Konvertierung_Lastgangdaten_Enercast.xlsm").Worksheets("Tabelle1").Range("D3:D36000").PasteSpecial (xlPasteAll)  
Range("A1").Select  

MsgBox "Bitte Spalte <N> ohne †berschrift in Spalte <A> einer neuen Datei speichern. Die neue Datei als *.csv speichern und entsprechend der Enercastbenennung bennen. Anschlie§end kann diese Datei zum Hochladen genutzt werden.", vbInformation, "Hinweis"  

End Sub


Kopieren Spalte "F" ab "F3":

Sub csvErzeugen()

Dim strDateiname As String, strPath As String
Dim i As Long, IngZeile As Long
Dim zeilePaste As Long
Dim Zelle As Range
Dim x As Long

strPath = "/Users/jk/LulatschServer/PrivateDokumente/Studium/Bachelorarbeit/WestfalenWind/Enercast/"  
strDateiname = InputBox("Bitte Dateinamen eingeben!", "Eingabe")  

zeilePaste = 1
x = 4

Open strPath & strDateiname & ".csv" For Output As #1  

For Each Zelle In Workbooks("Konvertierung_Lastgangdaten_Enercast.xlsm").Worksheets("Tabelle1").Range("A3:A36000")  
If IsDate(Zelle.Value) Then

If x = 4 Then
Zelle.Offset(0, 13).Copy
Workbooks(strDateiname & ".csv").Worksheets(strDateiname).Range("A" & zeilePaste).PasteSpecial (xlPasteValues)  
zeilePaste = zeilePaste + 1
x = 1
Else
x = x + 1
End If
Else
IsEmpty (Zelle.Value)
End If
Next Zelle

Range("A1").Select  

Close #1
End Sub

Vielen Dank!

Gruß Johannes
fehlermeldung
daten_quelldatei
fehlermeldung_debug
verarbeitung_1
verarbeitung_2_mit_falschen_werten_in_f

Content-Key: 5821771034

Url: https://administrator.de/contentid/5821771034

Printed on: April 27, 2024 at 23:04 o'clock