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

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 170954

Url: https://administrator.de/forum/ausgabe-eines-excel-vba-makros-in-eine-txt-datei-umleiten-170954.html

Ausgedruckt am: 24.04.2025 um 11:04 Uhr

2 Kommentare

Neuester Kommentar

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))  