Hallo Rainer,
Ich habe jetzt eine reine Excellösung, die direkt alle Dateien
eines Ordners nacheinander öffnet, dann pro Frequenz die
entsprechende Zeile in die entsprechende Frequensdatei (gibt
250 Stück davon) schreibt.
Aber Zodan macht da wohl jetzt FSO, naja, warte ich mal ab.
Aber nur, weil er Deine reine Excel-Lösung nicht kennt, denke
ich. 
Wenn es mein Problem wäre, würde ich Deine Lösung bevorzugen.
dankeschön
, ich habe im Anhang den Code gepostet.
Ich habe 100 xls-Dateien mit Zufallswerten angelegt, die jeweils 250 Zeilen a 5 Spalten haben.
Das Auslesen dieser 100 Dateien dauert pro Datei 0,3 Sek, danach habe ich alle Daten in einer Variablen, nun kommt der zweite Teil, Erzeugen der 250 Frequenzdateien und frequenzabhängiges Befüllen mit dem Inhalt der Variablen, da komme ich auf 0,7 Sek pro eine der 250 Dateien.
Wie sich der zweite Wert bei 50.000 Dateien erhöht kann ich nicht abschätzen.
Und die Variable, ich nenne sie mal „Bereich“ ist ein Array, oder auch keins, Ansichtssache, vielleicht weiß Thomas genaueres wie man sie bennent.
Unabhängig von Option Base 1 o.ä. hat sie keinen Index 0,0 wie normale Arrays.
Ich sage im Code einfach, nachdem ich die Datei Nummer x geöffnet habe: („Bereich“ habe ich schlicht mit „ReDim Bereich(AnzahlDateien)“ dimensioniert, ohne Klammern für die zeilen/Spaltendimensionen)
Bereich(x)=Range(„A1:E250“)
Dann kann ich die Datei schließen.
Will ich wissen, was in D3 einer beliebigen gelesenen Datei steht/stand, sage ich:
Msgbox Bereich(x)(3,4)
in dieser für dich vielleicht ungewohnten Syntax.
Ich habe nicht nachgesehen, es wird eine &h0 sein, ein leerer
Datensatz eben.
*schäm* jepp das macht großen Sinn, schreibe ich in eine leere Datei, einen leeren 1000ten Datensatz rein, so wird in die Datei halt vorher 999 mal ein Nullstring eingefügt. *seufz* hätte ich drauf komen können:frowning:
Gibt es in VB einen MemoryFree- bzw. auch MemoryUsed-Befehl?
Ich habe nichts entsprechendes gefunden. VB nutzt aber den
speicher des Systems, das kann man dann über die API finden.
Excel hat IMO eine eigene Speicherverwaltung kann also nicht
den gesamten Speicher von Windows nutzen.
In Excel-Vba soll MemoryFree angeblich laut Hilfe den
Speicherplatz in Byte angeben den Excel noch nutzen könnte,
MemoryUsed den byteplatz den Ecel schon belegt.
Das kann aber so nicht stimmen oder ich übersehe etwas bei
Redim.
Sub nn()
Dim c As Double
MsgBox Application.MemoryUsed 'je nach Rechner unterschiedlich
MsgBox Application.MemoryFree 'bei 2 Rechnern immer 1048675
ReDim a(Application.MemoryFree) As String * 10
a(1) = „1234567890“
MsgBox UBound(a)
MsgBox Application.MemoryFree
MsgBox Application.MemoryUsed
Dim b
End Sub
Das Dim a() steht aber wo anders, oder?
Nein, ReDim bei Excel bedingt kein vorheriges Dim in Excel.
Aber auch ein vorheriges Dim a(1000000) würde nichts bringen *schätz*
Und zu Redim, in Excel klappt das so problemlos:
Sub Test()
ReDim a(10)
a(5) = „7“
MsgBox a(5)
End Sub
Die ausgegebenen Werte sind immer die gleichen, egal ob
zwischendurch a dimensioniert wird. Da ich ja a(1) mit Werten
belege, muß das m.E. in einem Speicherbereich geschehen, der
nicht von Memoryused überwacht wird *rätsel*
Keine Ahnung, was Excel da treibt.
Na, da sind wir schon 2 
Aber grad in so Fällen wie hier mit Zodan mit zigtausend Dateien usw. ist es doch unabdingbar, grad wegen Dim, Redim, zu wissen wieviel Platz man noch im jeweiligen Arbeitsspeicher hat.
Eine Lösung riecht sehr nach API, mal schauen.
Und mag ja sein, daß ein einfaches Dim,Redim vielleicht nur schaut ob genug Platz da ist und noch gar keinen reserviert, aber mit a(1) = „1234567890“ belege ich definitiv Platz und da beide Befehle Bytesgenau sein sollen, müßten sie die 10 fehlenden Bytes anzeigen.
Hat VB eine MsgBox-Anweisung
Ja.
bzw. kannst du dir hierauf einen Reim machen:
Sub nn2()
Dim c As Double
c = 120000000 'klappt problemlos
MsgBox c
c = 10 * 12000
MsgBox c ’ ergibt Laufzeitfehler 6, Überlauf !?
End Sub
Der fehler tritt schon in
c = 10 * 12000 auf.
Aargs, du hast Recht. Noch ein Eintrag in meine Todoliste:„Warum kam der Debugger bei mir erst bei der MsgBox“ *gg*
Keine Ahnung warum. Aber
c = 10& * 12000&
geht.
Gut, ein workaround. D.h. auch in VB kann MsgBox zwar 120000000 und noch größer anzeigen, aber 10 * 12000 nicht.
Nachfolgend meine ersten Gehschritte mit CopyMemory. Du
hattest Recht, mein erster Ansatz um Arrays umzustellen war
von der Logik her falsch. Aber um Arrays zu manipieren ist
Copymemory äußerst brauchbar.
Und dein Tipp Copymemory erstmal nur mit String-Variablen zu
testen war Gold wert, erst dadurch kam ich soweit daß das
überhaupt mal klappte.
Ich muß nur noch herausfinden, warum „ByVal“ da so wichtig
ist. Wenn man es fälschlicherweise wegläßt oder
fälschlicherweise benutzt, kommt entweder der Debugger, oder
man muß Excel neu starten da es im Bruchteil von Sekunden
verschwunden ist.
ByVal - Das Argument wird als Wert übergeben.
ByRef - Das Argument wird als Referenz übergeben.
Ja, das ist mir bekannt, und ByRef ist in Excel Voreinstellung wenn nichts angegeben wird, grad bei CopyMemory sah ich das ich überhaupt nicht weiß wann ich was benutzen muß.
An die API muss der Inhalt, der Wert des Zeigers übergeben
werden, denn das ist die Speicheradresse an der der Inhalt
steht, den Du bearbeiten willst. Lässt Du ByVal weg, wird
‚default‘, also ByRef übergeben, das ist die Adresse des
Zeigers. Dann bearbeitest du den Zeiger selbst, nicht den
Speicher auf den der Zeiger zeigt. Das verkraftet Windows
nicht und schließt die Anwendung.
Schau mal bitte genauer die Codes an, da wo ByVal steht verlangte es Excel, da wo es nicht steht, verbat sich Excel daß es dort steht. Das verstehe ich nicht, bzw. die Logik dahinter.
Ich hatte deinen VarPtr als Variablennamen angesehen und deshalb in deinem letzten Code nicht so beachtet.
Wieder was für die Todoliste: „Varptr benutzen, schauen ob Excel den kennt“
*hmmh* Grundsätzlich, so wie die drei Codes da stehen funktionieren sie problemlos, auch ohne varptr.
Mir gings ja darum herauszufinden warum sie nicht mehr klappen wenn ich mal ein vorhandenes Byval lösche, bzw. eins mal dazufüge, weil dann laufen sie nicht mehr.
Sub ff()
Dim a(5, 3) As Single, b As Single
Call CopyMemory(ByVal b, ByVal a(2, 1), 4)
MsgBox b
End Sub
Bei b fehlt ‚VarPtr‘, Du musst den Pointer übergeben, sonst
ist das keine Adresse im Speicher. Vom Array übergbst Du mit
ByVal den Inhalt des Arrays, statt dem Verweis, der die
Adresse enthält.
CopyMemory ByVal VarPtr(b), a(2, 1), 4
Das sollte besser klappen, nicht getestet, nur hier getippt.
-)
Sub ff2()
Dim a(5, 3) As Satz, b As Satz
Call CopyMemory(b, a(2, 1), 16)
MsgBox b.Frequenz
MsgBox b.Messwert(1)
End Sub
Da fehlt wohl wieder VariablenPointer.
Sub ff3()
Dim a(5, 3) As Satz, b(3) As Satz, N, nn
For N = 0 To 3
Call CopyMemory(b(N), a(2, N), 10)
MsgBox b(N).Frequenz
For nn = 0 To 3
MsgBox b(N).Messwert(1)
Drei mal den selben Wert? 
Next nn
Next N
End Sub
Danke ^ Gruß
Reinhard
Option Explicit
Private Bereich()
'
Sub Test()
Range("A1") = Now()
Call Einlesen("C:\FreqTest2")
Range("A2") = Now()
Call Schreiben("C:\FreqTest2")
Range("A3") = Now()
End Sub
'
Sub Schreiben(Pfad As String)
Dim bytN, Merker As Byte, lngB As Long
Application.ScreenUpdating = False
Merker = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Application.DisplayAlerts = False
Workbooks.Add
For bytN = 1 To 250
Application.StatusBar = "Schreibe Datei " & bytN & " / " & 250
For lngB = 1 To UBound(Bereich)
Cells(lngB, 1) = Bereich(lngB)(bytN, 1)
Cells(lngB, 2) = Bereich(lngB)(bytN, 2)
Cells(lngB, 3) = Bereich(lngB)(bytN, 3)
Cells(lngB, 4) = Bereich(lngB)(bytN, 4)
Cells(lngB, 5) = Bereich(lngB)(bytN, 5)
Next lngB
ActiveWorkbook.SaveAs FileName:=Pfad & "\Freq" & Format(bytN, "000")
Next bytN
ActiveWorkbook.Close
Application.StatusBar = ""
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.SheetsInNewWorkbook = Merker
End Sub
'
Sub Einlesen(Pfad As String)
Dim N
On Error GoTo Fehler
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = Pfad
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
.Execute
ReDim Bereich(.FoundFiles.Count)
For N = 1 To .FoundFiles.Count
Application.StatusBar = "Lese Datei " & N & " / " & .FoundFiles.Count
Workbooks.Open .FoundFiles(N)
Bereich(N) = Range("A1:E250")
ActiveWorkbook.Close savechanges:=False
Next N
End With
Fehler:
If Err.Number 0 Then MsgBox "Es tat der Fehler " & Err.Number & " auf" & Chr(13) \_
& Err.Description
Application.StatusBar = ""
Application.ScreenUpdating = True
End Sub