Schönen guten Tag zusammen,
Ich habe ein (eigentlich) sehr einfaches Problem:
Ich hätte gerne den gesammten Inhalt (außer Leere Zellen) von einem Blatt in eine Export.txt kopiert.
So sieht die bisherige Lösung aus:
Code:
Private Sub CommandButton1_Click()
Dim F%, oLO As ListObject, C%, R&
F = FreeFile
Open ThisWorkbook.Path & "\Export.txt" For Output As #F
For Each oLO In ListObjects
With oLO.Range
For C = 1 To .Columns.Count
R = 2
While .Cells(R, C).Text > ""
Print #F, .Cells(R, C).Text
R = R + 1
Wend
Next
End With
Next
Close #F
End Sub
Ich bin was VBA angeht ein absoluter Anfänger, dieser Code stammt also nicht von mir, funktioniert allerdings gut bis auf ein Problem:
Die Spalten A & B werden am Schluss der Textdatei angehangen, anstatt am Anfang.
Anbei habe ich eine kleine Beispieldatei angehangen und zusätzlich die Export.txt, wie ich sie gerne hätte.
[
attachment=38709][
attachment=38710]
Ich hoffe jemand kann mir helfen, ich habe mit eigenen Ansätzen es immer nur noch schlimmer gemacht
Vielen Dank im Vorraus
MfG Niclas
Hallo Namensvetter
Warum es mit Deinem Makro nicht funktioniert - das habe ich nicht durchschaut. Aber ich meine, mit dem folgenden sollte es klappen:
Code:
Sub test2()
Dim F%, clast%, rlast%, rc%, rz%, cv
F = FreeFile
Open ThisWorkbook.Path & "\Export.txt" For Output As #F
clast = Range("A1").SpecialCells(xlCellTypeLastCell).Column
rlast = Range("A1").SpecialCells(xlCellTypeLastCell).Row
For rc = 1 To clast
For rz = 2 To rlast
cv = Cells(rz, rc).Value
If cv > "" Then
Print #F, cv
End If
Next rz
Next rc
Close #F
End Sub
Grüsse Niclaus
Danke für die schnelle Antwort, schöner Name
Zitat:Warum es mit Deinem Makro nicht funktioniert - das habe ich nicht durchschaut.
Da bin ich ja beruhigt :)
Zitat:Aber ich meine, mit dem folgenden sollte es klappen:
Code:
Code:
Sub test2()
Dim F%, clast%, rlast%, rc%, rz%, cv
F = FreeFile
Open ThisWorkbook.Path & "\Export.txt" For Output As #F
clast = Range("A1").SpecialCells(xlCellTypeLastCell).Column
rlast = Range("A1").SpecialCells(xlCellTypeLastCell).Row
For rc = 1 To clast
For rz = 2 To rlast
cv = Cells(rz, rc).Value
If cv > "" Then
Print #F, cv
End If
Next rz
Next rc
Close #F
End Sub
Das funktioniert einwandfrei und deutlich schneller als meiner, ganz vielen lieben Dank!
Eine Bonusfrage hätte ich allerdings noch:
Wäre es nun möglich den Button auf ein andres Blatt zu setzen oder macht das wenig Sinn?
MfG Niclas
Das freut mich, dass das Makro funktioniert.
Selbstverständlich kannst Du in jedem beliebigen Blatt einen Button setzen. Dazu gibt es verschiedene Möglichkeiten. Eine davon (Office 2013):
Menü ENTWICKLERTOOLS / Steuerelemente / Einfügen: Schaltfläche (Formularsteuerelement)
Dieser Schaltfläche: Makro zuweisen (Makros: In diese Arbeitsmappe): test2
Ich hoffe, auch das hilft Dir.
Grüsse Niclaus
Danke für deine Antwort
(11.05.2021, 10:55)Niclaus schrieb: [ -> ]Selbstverständlich kannst Du in jedem beliebigen Blatt einen Button setzen. Dazu gibt es verschiedene Möglichkeiten. Eine davon (Office 2013):
Menü ENTWICKLERTOOLS / Steuerelemente / Einfügen: Schaltfläche (Formularsteuerelement)
Dieser Schaltfläche: Makro zuweisen (Makros: In diese Arbeitsmappe): test2
Das funktioniert soweit, nur bekomme ich beim drücken des Knopfes dann den Inhalt des Blattes auf dem sich der Knopf befindet, nicht dort wo meine sortierten Daten liegen.
Ich hätte gerne meine Daten (fertig für Export) auf Blatt 1 und den Knopf auf Blatt 2, welcher auf das Blatt 1 verweist, also eine Art Verknüpfung oder ein "Ausführen in:" hatte ich mir vorgestellt, bin allerdings noch nicht fündig geworden.
(Meine Office Version ist 2016 ProPlus)
Damit es klar ist: Die Daten, die verarbeitet werden sollen, befinden sich in Deiner hochgeladenen Datei in "Tabelle1".
In dieser oder in jeder beliebigen andern Tabelle dieser Datei kannst Du einen Button einfügen, der sich auf das Makro test2 bezieht.
Dieses Makro musst Du leicht ergänzen mit der Zeile "With ...", mit jeweils einem Punkt vor "Range" und vor "Cells" und mit der Zeile "End With".
Code:
Sub test2()
Dim F%, clast%, rlast%, rc%, rz%, cv As Variant
F = FreeFile
Open ThisWorkbook.Path & "\Export.txt" For Output As #F
With Sheets("Tabelle1")
clast = .Range("A1").SpecialCells(xlCellTypeLastCell).Column
rlast = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
For rc = 1 To clast
For rz = 2 To rlast
cv = .Cells(rz, rc).Value
If cv > "" Then
Print #F, cv
End If
Next rz
Next rc
End With
Close #F
End Sub
Grüsse Niclaus
Du bist einfach genial
Funktioniert genau, wie ich mir das gedacht habe.
Vielen Dank nocheinmal, jetzt kann ich mein Projekt endlich abschließen :))