24.05.2016, 14:40
Hallo liebe Profis,
ich brauche Hilfe bei meinem kleinen Makro, welches einwandfrei funktioniert aber doch noch etwas optimiert werden soll.
An der Stelle (Siehe Ausschnitt) werden nach und nach Zellen ausgewählt, welche in eine Textdatei eingetragen werden. Jedoch beträgt die Länge des Programms nicht immer 100.500 Zellen. Es könnten auch nur 95.000 sein. Am Ende( bei 100.500) befindet sich allerdings noch ein Text, welcher auch in die TXT- Datei übertragen werden soll. Demnach sollen leere Zellen, wenn sich soetwas einfach in den Code einfügen lässt, ignoriert werden, bis wieder Text in einer Zelle steht. Ist soetwas über einen einfach IF- ELSE- Befehl möglich? Bis jetzt übernimmt er auch die leere Zellen in die Text- Datei. Das mach die spätere Datei etwas zu groß :20:
Hier nochmal der ganze Code
Ich bedanke mich für eure Mühen :19:
ich brauche Hilfe bei meinem kleinen Makro, welches einwandfrei funktioniert aber doch noch etwas optimiert werden soll.
An der Stelle (Siehe Ausschnitt) werden nach und nach Zellen ausgewählt, welche in eine Textdatei eingetragen werden. Jedoch beträgt die Länge des Programms nicht immer 100.500 Zellen. Es könnten auch nur 95.000 sein. Am Ende( bei 100.500) befindet sich allerdings noch ein Text, welcher auch in die TXT- Datei übertragen werden soll. Demnach sollen leere Zellen, wenn sich soetwas einfach in den Code einfügen lässt, ignoriert werden, bis wieder Text in einer Zelle steht. Ist soetwas über einen einfach IF- ELSE- Befehl möglich? Bis jetzt übernimmt er auch die leere Zellen in die Text- Datei. Das mach die spätere Datei etwas zu groß :20:
Code:
For zz = 50013 To 100500
Print #nr, .Cells(zz, 1).Text
Next zz
Hier nochmal der ganze Code
Code:
Sub TxtAusCode()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim strD As String, strN, nr As Integer, zz As Long
Sheets("Verarbeitung").Select
Range("V21:V50002").Select
Selection.Copy
Range("A50484").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
strD = CurDir()
strN = Application.GetSaveAsFilename(InitialFileName:="F:\exc\w-w-w\tmp\xxx.txt", _
FileFilter:="Textdateien (*.txt), *.txt", Title:="")
If VarType(strN) = vbBoolean Then Exit Sub
nr = FreeFile(1)
Open strN For Output As #nr
With Sheets("Verarbeitung")
For zz = 50013 To 100500
Print #nr, .Cells(zz, 1).Text
Next zz
End With
Close nr
ChDrive strD
ChDir strD
Sheets("Arbeitsblatt").Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Call Calculate
End Sub
Ich bedanke mich für eure Mühen :19: