Ausgabe eines Excel VBA-Makros in eine .txt-Datei umleiten

Hallo zusammen,

ich habe folgendes Problem und hoffe ihr könnt mir weiterhelfen. Ich habe in einer Excel-Tabelle mehrere Spalten mit Parametern und brauche von diesen Parametern alle Kombinationen. Ein VBA-Skript das mir diese Kombinationen erzeugt habe ich schon geschrieben. Das Problem ist jetzt, dass Excel 2003 "nur" 65536 Zeilen hat, ich aber mittlerweile mehr Kombinationen brauche. Das Makro funktioniert also nicht mehr.

Gibt es eine Möglichkeit die Ausgabe des Makros direkt in eine Textdatei, zum Beispiel auf dem Desktop, umzuleiten, damit ich das Platzproblem umgehe. Der Code für das bisherige Kombinations-Makro sieht so aus:

Sub combinations()

Dim c1() As Variant
Dim c2() As Variant
Dim c3() As Variant
Dim c4() As Variant
Dim c5() As Variant
Dim c6() As Variant
Dim out() As Variant
Dim j, k, l, m, n, o, p As Long


Dim col1 As Range
Dim col2 As Range
Dim col3 As Range
Dim col4 As Range
Dim col5 As Range
Dim col6 As Range
Dim out1 As Range


Set col1 = Range("A2", Range("A2").End(xlDown))  
Set col2 = Range("B2", Range("B2").End(xlDown))  
Set col3 = Range("C2", Range("C2").End(xlDown))  
Set col4 = Range("D2", Range("D2").End(xlDown))  
Set col5 = Range("E2", Range("E2").End(xlDown))  
Set col6 = Range("F2", Range("F2").End(xlDown))  

c1 = col1
c2 = col2
c3 = col3
c4 = col4
c5 = col5
c6 = col6

Set out1 = Range("H2", Range("M2").Offset(UBound(c1) * UBound(c2) * UBound(c3) * UBound(c4) * UBound(c5) * UBound(c6)))  
out = out1

j = 1
k = 1
l = 1
m = 1
n = 1
o = 1
p = 1

Do While p <= UBound(c6)
    Do While o <= UBound(c5)
        Do While n <= UBound(c4)
            Do While j <= UBound(c3)
                Do While k <= UBound(c2)
                    Do While l <= UBound(c1)
                        out(m, 1) = c1(l, 1)
                        out(m, 2) = c2(k, 1)
                        out(m, 3) = c3(j, 1)
                        out(m, 4) = c4(n, 1)
                        out(m, 5) = c5(o, 1)
                        out(m, 6) = c6(p, 1)
                        m = m + 1
                        l = l + 1
                    Loop
                    l = 1
                    k = k + 1
                Loop
                k = 1
                j = j + 1
            Loop
            j = 1
            n = n + 1
        Loop
        n = 1
        o = o + 1
    Loop
    o = 1
    p = p + 1
Loop

out1.Value = out
End Sub

Please also mark the comments that contributed to the solution of the article

Content-Key: 170954

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

Printed on: April 25, 2024 at 01:04 o'clock

2 Comments

Latest comment

Hallo jschikora!

Du könntest vor Zeile 46 das Trennzeichen zwischen den einzelnen Werten festlegen sowie die Zieldatei erstellen mit

Delim = vbTab 'Trennzeichen zwischen den Spalten  

Set fso = CreateObject("Scripting.FileSystemObject")  
Set Datei = fso.CreateTextFile(CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Ausgabe.txt")  

und dann die Zeilen 53 bis 58 durch

Datei.WriteLine c1(l, 1) & Delim & c2(k, 1) & Delim & c3(j, 1) & Delim & c4(n, 1) & Delim & c5(o, 1) & Delim & c6(p, 1)

ersetzen.

Das Testen überlasse ich Dir ...

Grüße
bastla

Hallo jschikora!

Den Anfangsteil könnte man etwas vereinfachen:

    Set col1 = Range("A2", Range("A2").End(xlDown))  
    Set col2 = Range("B2", Range("B2").End(xlDown))  
    Set col3 = Range("C2", Range("C2").End(xlDown))  
    Set col4 = Range("D2", Range("D2").End(xlDown))  
    Set col5 = Range("E2", Range("E2").End(xlDown))  
    Set col6 = Range("F2", Range("F2").End(xlDown))  
    
    Set cols = Union(col1, col2, col3, col4, col5, col6)
    
    For Each cell In cols.Cells
       'durläuft alle Zellen von col1 - col6  
    Next
    
    Set out1 = Range("H2", Range("M2").Offset(cols.Cells.Count - 1))  

Gruß Dieter

German solved Question Microsoft Office Microsoft

Hotly discussed

Check of ZFW Firewallgleixnerd - 5 Comments

Wireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 Comments