MS-Office-Forum
Google
   

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads Der Renner, 11 Entwicklertools für Access, Tipps & Trick und offene Datenbanken zum einzigartigen Preis.
Themen-Optionen Ansicht
Alt 04.04.2017, 09:37   #1
Steffwgt
Neuer Benutzer
Neuer Benutzer
Standard Frage - Wenn Bedingung zutrifft, dann für zwei Zeilen Textdatei erzeugen

Standard VBA - Textdatei für jede Zeile erzeugen


Hallo zusammen,

ich bin neu hier und habe so gut wie keine Erfahrungen in Excel VBA

Ich habe die Aufgabe bekommen, einen Code zu schreiben, der für jede Zeile meines Tabellenblattes eine neue Textdatei erzeugt. Das habe ich soweit auch hinbekommen.
Der Name der gespeicherten Textdateien ist der gleiche wie in der ersten Spalte, also die Zellen in der ersten Spalte.
Aber jetzt gibt es auch noch eine Nebenbedingung:
Die erste Spalte handelt sich um Artikelnummern.
Wenn zwei oder mehrere Artikelnummern untereinander gleich sind(in der ersten Spalte), dann sollen diese in eine Textdatei geschrieben werden und nicht in einzelne.

'******************************** Für jede Zeile wird eine Textdatei erzeugt ****************************************************************
Sub imaSchnittstelle()

lz = Sheets("KFL_allePrgr_23032017").Cells(Rows.Count, "A").End(xlUp).Row
Pfad = "C:UsersDesktopTextdateien für IMA Schnittstelle"
For i = 8 To lz
x = Cells(i, 1)
Open Pfad & x & ".txt" For Output As #1

Print #1, Cells(i, 1) & " ;" & "0000;"
Print #1, "0010" & " ;" & Cells(i, 10) & " ;" & Cells(i, 10) & _
" ;" & Cells(i, 18) & ";" & _
Cells(i, 17) & ";" & Cells(i, 5) & ";" & Cells(i, 9) & ";" & Cells(i, 16) & ";" & Cells(i, 11) & _
" ;" & Cells(i, 20) & ";" & Cells(i, 21)
Close #1
Next i

If ActiveCell = ActiveCell.Offset(1) Then
m = ActiveCell.Offset(1)
Open Pfad For Append As #1
Print #1, m
Close #1
End If


MsgBox " Die Textdateien wurden im Verzeichnis: C:UsersDesktopTextdateien für IMA Schnittstelle gespeichert"
End Sub


So sieht momentan mein Code aus ..
Die fett markierte Stelle sollte genau das tun, was ich in der Nebenbedingung beschrieben habe, aber das tut es nicht
Kann mir jemand helfen ?
Liebe Grüße und Danke !
Steffwgt ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 04.04.2017, 09:49   #2
FloGrom
MOF User
MOF User
Standard

*geloescht* Was ich geschrieben hatte, ist wohl schon so im Code vorhanden...

Aber, setze doch mal einen Break im Code und schau doch mal (Schritt fuer Schritt) an was er macht, bzw. wo das Problem liegt, beim ueberpruefen mit IF, beim schreiben des Inhaltes etc...

"Vielleicht" scheitert es schon hier...
If ActiveCell = ActiveCell.Offset(1) Then
....
If ActiveCell.Value = ActiveCell.Offset(1).Value Then

*Edit*
Simmt, mit dem Post von Fennek11 habe ich gesehen das deine IF abfrage ausserhalb der Schleife sich befindet. Kann ja dann so nicht funktionieren. Musst diese mit in die Schleife einbauen, IF ActiveCell = ActiveCell.Offset(1) Then *Hinzufuegen in vorhandener Datei* SONST Dein vorheriger Code



Viele Gruesse
Flo

Geändert von FloGrom (04.04.2017 um 10:09 Uhr).
FloGrom ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 04.04.2017, 09:59   #3
Fennek11
MOF User
MOF User
Standard

Hi Stefanie, (von Herber)

falls es max 2 Zeilen sind, die direkt untereinander stehen, dann käme dieser (ungeprüfte) Code in Frage:

PHP-Code:

Sub imaSchnittstelle()

lz Sheets("KFL_allePrgr_23032017").Cells(Rows.Count"A").End(xlUp).Row
Pfad 
"C:UsersDesktopTextdateien für IMA Schnittstelle"
For 8 To lz
Open Pfad 
Cells(i1) & ".txt" For Output As #1

Print #1, Cells(i, 1) & " ;" & "0000;"
Print #1, "0010" & " ;" & Cells(i, 10) & " ;" & Cells(i, 10) & _
" ;" Cells(i18) & ";" _
Cells
(i17) & ";" Cells(i5) & ";" Cells(i9) & ";" Cells(i16) & ";" Cells(i11) & _
" ;" Cells(i20) & ";" Cells(i21)
############ neu 
If Cells(i1) = Cells(i+11Then
    i 

    
Print #1, "0010" & " ;" & Cells(i, 10) & " ;" & Cells(i, 10) & _
" ;" Cells(i18) & ";" _
Cells
(i17) & ";" Cells(i5) & ";" Cells(i9) & ";" Cells(i16) & ";" Cells(i11) & _
" ;" Cells(i20) & ";" Cells(i21)
end if
Next i

Close 
#1
End If 
(In der Schleife den Index zu ändern, gehört sich nicht)

Um die genannten Bedingungen aufzulösen, müßte man einen Autofilter setzen.

mfg
Fennek11 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 04.04.2017, 10:38   #4
Steffwgt
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Hi Fennek & FloGrom

den If-Teil habe ich beabsichtigt aus der Schleife genommen, weil es eh nicht funktioniert hat ..
Ich habe das mit dem Code jetzt getestet, aber jetzt werden auch keine Textdateien mehr erzeugt :/
Die für die erste wird erzeugt aber dann kommt eine Fehlermeldung, dass die Datei schon bereits geöffnet ist und die Schleife läuft nicht weiter.
Welchen Teil am Code müsste ich dazu ändern ?

Lg
Steffwgt ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 04.04.2017, 10:47   #5
FloGrom
MOF User
MOF User
Standard

Hallo Steffwgt,

Code:

For i = 8 To lz
x = Cells(i, 1)
Open Pfad & x & ".txt" For Output As #1

Print #1, Cells(i, 1) & " ;" & "0000;"
Print #1, "0010" & " ;" & Cells(i, 10) & " ;" & Cells(i, 10) & _
" ;" & Cells(i, 18) & ";" & _
Cells(i, 17) & ";" & Cells(i, 5) & ";" & Cells(i, 9) & ";" & Cells(i, 16) & ";" & Cells(i, 11) & _
" ;" & Cells(i, 20) & ";" & Cells(i, 21)
Close #1
Next i

If ActiveCell = ActiveCell.Offset(1) Then
m = ActiveCell.Offset(1)
Open Pfad For Append As #1
Print #1, m
Close #1
End If
Also wenn dieser Code bisher bei dir Funktioniert. Wenigstens der obere Teil.
Dann sollte so der zusammen genommene Code aussehen

Code:

For i = 8 To lz
x = Cells(i, 1)
Open Pfad & x & ".txt" For Output As #1

If ActiveCell = ActiveCell.Offset(1) Then

m = ActiveCell.Offset(1)
Open Pfad For Append As #1
Print #1, m
Close #1

Else

Print #1, Cells(i, 1) & " ;" & "0000;"
Print #1, "0010" & " ;" & Cells(i, 10) & " ;" & Cells(i, 10) & _
" ;" & Cells(i, 18) & ";" & _
Cells(i, 17) & ";" & Cells(i, 5) & ";" & Cells(i, 9) & ";" & Cells(i, 16) & ";" & Cells(i, 11) & _
" ;" & Cells(i, 20) & ";" & Cells(i, 21)
Close #1
End if

Next i
FloGrom ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 04.04.2017, 10:52   #6
Steffwgt
Threadstarter Threadstarter
Neuer Benutzer
Neuer Benutzer
Standard

Der obere Teil hatte bisher prima funktioniert, aber wenn ich die beiden Teile zusammensetzen will, funktioniert gar nichts mehr

Ich glaube, der untere Teil von meinem Code taugt nichts
Außerdem sollte ja die komplette Zeile gespeichert werden unter m, also genau wie oben, nur diese bestimmte Zellen, aber das macht bei meinem Code irgendwie auch keinen Sinn merke ich gerade ..

Hilfeeee
Steffwgt ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 04.04.2017, 11:23   #7
Fennek11
MOF User
MOF User
Standard

erneut ungeprüft:

anstelle von

PHP-Code:

Next i

Close 
#1 
besser
PHP-Code:

close #1
next i 
Fennek11 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 16:14 Uhr.


Partner und Co.
Access-Paradies -Alles rund um die Datenbank Microsoft Access -Code -Programme-Tools -Tipps   Kostenlose Tipps & Tricks, Downloads und Programme   www.kulpa-online.com - Tipps - Tricks - Tutorials - Meinungen - Downloads uvm...   vb@rchiv · Willkommen in der Welt der VB Programmierung   Access-Garhammer - Hier finden Sie jede Menge Beispiel-Datenbanken zu Access und mehr ...   mcseboard.de   Die Top Seite für Excel-VBA-Makros uvm.

Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.

Copyright ©2000-2010 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günther Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.
Beachten Sie bitte auch unsere Nutzungsbedingungen.