Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 12:29:20
VBA nur Zeilen mit bestimmten Eintrag selektieren
23.04.2024 11:26:57
Probleme mit tbl.Listrows.add
23.04.2024 10:55:14
Zeilen sortieren
23.04.2024 10:23:52
Tabelle 90° drehen + Filteroptionen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
460to464
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
460to464
460to464
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

im Makro datei von bis bearbeiten (lesen!!!)

im Makro datei von bis bearbeiten (lesen!!!)
30.07.2004 12:58:33
bis
Hallo alle zusammen!
Ich binns mal wieder!
Ich habe in der Rechersche nichts passendes gefunden.
ganz von vorn:
ich habe Textdateien die mehr als 65... Zeilen haben.
Die lasse ich per makro Teilen.
Ich habe 37 Textdateien die nochmal alle in 3-47 einzelne textdateien
geteilt werden. insgesamt sind es ca. 300 textdateien.
die muss ich alle in eine exceldatei umwandeln und mit einem kopf versehen.
Das mache ich auch alles per Makro. Bloss das ich das Makro 300 mal kopieren muss und die Dateinamen ändern muss.
============================================================================
Jetzt meine Frage:
die TXT´s heisen alle 400 + zusatz (bis 37) also 400.001, 400.002, usw...............
nach dem oben erwähnten teilen in txt´s mit 65000 Zeilen heisen die
400.001-1, 400.001-2, usw...
ich hab mir aufgeschrieben vieviele dateien entstanden sind. 400.001 sind zb 7,
400.002 sind 8, usw....
=====
anstatt wie bei 400.001 das makro 7 mal zu kopieren kann man da nicht irgendwie sagen 400.001-1 bis 400.001-7?
(beim speichern muss die Zahl hinter dem - auch geschrieben werden.
hier das makro:
ChDir "C:\Dokumente und Einstellungen\XXX\400"
Workbooks.OpenText Filename:= _
"C:\Dokumente und Einstellungen\XXX\400\400.001-1.txt", _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 2), Array(22, 2), Array(26, 2), Array(29, 2), Array(34, 2), Array(39, 2), _
Array(42, 2), Array(51, 2), Array(56, 2), Array(60, 2), Array(80, 2), Array(81, 2))
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "AAA"
Columns("B:D").Select
Selection.Delete Shift:=xlToLeft
Range("B1").Select
ActiveCell.FormulaR1C1 = "BBB"
Range("C1").Select
ActiveCell.FormulaR1C1 = "CCC"
Range("D1").Select
ActiveCell.FormulaR1C1 = "DDD"
Range("E1").Select
ActiveCell.FormulaR1C1 = "EEE"
Range("F1").Select
ActiveCell.FormulaR1C1 = "FFF"
Range("G1").Select
ActiveCell.FormulaR1C1 = "GGG"
Range("H1").Select
ActiveCell.FormulaR1C1 = "HHH"
Range("I1").Select
ActiveCell.FormulaR1C1 = "III"
Rows("1:1").Select
Selection.Font.Bold = True
Range("A1").Select
ActiveWindow.SmallScroll Down:=-9
ChDir "C:\Dokumente und Einstellungen\XXX\400 excel"
ActiveWorkbook.SaveAs Filename:= _
"C:\Dokumente und Einstellungen\XXX\400 excel\400.001-1.xls" _
, FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
Fals mir jemand Helfen kann - Vielen Vielen Dank!!!
MFG
Martin S.

20
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: im Makro datei von bis bearbeiten (lesen!!!)
30.07.2004 13:50:05
bis
Hallo,
mach das halt mit einer (oder mehreren geschachtelten) for-Schleifen. Darin erzeugst du den Namen und rufst das Makro auf.
Also
for zaehler = 0 to 400 do
dim dateiname as String
dateiname = "BlaBlub" & zaehler & ".txt"
'Makro
next zaehler
AW: im Makro datei von bis bearbeiten (lesen!!!)
30.07.2004 13:55:17
bis
Hallo Martin,
mit folgendem Makro werden alle Textdateien aus dem TXT-Ordner eingelesen und als
Exceldateien im Excel-Ordner abgespeichert: 

Sub TXTzuXLS()
Dim myDatei As String
On Error GoTo Ende
Application.ScreenUpdating = False
myDatei = Dir("C:\Dokumente und Einstellungen\XXX\400")
Do While myDatei <> ""
With Workbooks.OpenText(FileName:=myDatei, _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 2), Array(22, 2), Array(26, 2), Array(29, 2), Array(34, 2), Array(39, 2), _
Array(42, 2), Array(51, 2), Array(56, 2), Array(60, 2), Array(80, 2), Array(81, 2)))
.Rows("1:1").Insert Shift:=xlDown
.Range("A1") = "AAA"
.Columns("B:D").Delete Shift:=xlToLeft
.Range("B1") = "BBB"
.Range("C1") = "CCC"
.Range("D1") = "DDD"
.Range("E1") = "EEE"
.Range("F1") = "FFF"
.Range("G1") = "GGG"
.Range("H1") = "HHH"
.Range("I1") = "III"
.Rows("1:1").Font.Bold = True
.Range("A1").Select
.SaveAs FileName:="C:\Dokumente und Einstellungen\XXX\400 excel\" & _
Left(.Name, Len(.Name) - 4) & ".xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
.Close
End With
myDatei = Dir
Loop
Ende:
Application.ScreenUpdating = True
End Sub
Gruß Uwe
Anzeige
AW: im Makro datei von bis bearbeiten (lesen!!!)
30.07.2004 14:27:20
bis
Danke Uwe!
Sieht sehr gut aus!
Hier zeigt er mir nur einen Fehler. Kenn mich nicht all zu gut aus
sodas ich nicht von allein den Fehler beheben kann.
With Workbooks. -> OpenText Danke schonmal für die schnelle Hilfe und alles!
MFG
Martin S.
AW: im Makro datei von bis bearbeiten (lesen!!!)
30.07.2004 14:41:10
bis
Hallo Martin,
probiers mal damit: 

Sub TXTzuXLS()
Dim myDatei As String
On Error GoTo Ende
Application.ScreenUpdating = False
myDatei = Dir("C:\Dokumente und Einstellungen\XXX\400")
Do While myDatei <> ""
Workbooks.OpenText FileName:=myDatei, _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 2), Array(22, 2), Array(26, 2), Array(29, 2), Array(34, 2), Array(39, 2), _
Array(42, 2), Array(51, 2), Array(56, 2), Array(60, 2), Array(80, 2), Array(81, 2))
With ActiveWorkbook
.Rows("1:1").Insert Shift:=xlDown
.Range("A1") = "AAA"
.Columns("B:D").Delete Shift:=xlToLeft
.Range("B1") = "BBB"
.Range("C1") = "CCC"
.Range("D1") = "DDD"
.Range("E1") = "EEE"
.Range("F1") = "FFF"
.Range("G1") = "GGG"
.Range("H1") = "HHH"
.Range("I1") = "III"
.Rows("1:1").Font.Bold = True
.Range("A1").Select
.SaveAs FileName:="C:\Dokumente und Einstellungen\XXX\400 excel\" & _
Left(.Name, Len(.Name) - 4) & ".xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
.Close
End With
myDatei = Dir
Loop
Ende:
Application.ScreenUpdating = True
End Sub
Gruß Uwe
Anzeige
AW: im Makro datei von bis bearbeiten (lesen!!!)
30.07.2004 14:52:04
bis
leider immer noch nicht.
Keine Fehlermeldung mehr! aber es passiert nichts!
Kannst mir da nochmal helfen?
MFG
Martin S.
AW: im Makro datei von bis bearbeiten (lesen!!!)
30.07.2004 15:04:15
bis
Hallo Martin,
hast Du meine letzte Nachricht auch gelesen?
Gruß Uwe
AW: im Makro datei von bis bearbeiten (lesen!!!)
30.07.2004 15:08:45
bis
Ja. Danach erst aber das hatte ich auch schon gesehen.
Hat es vieleicht was mit denn Befehl " wenn Fehler gehe zum Ende " oder so in etwa
zu tun?
Ich hab das ganze auf einen Button gelegt und das Bild Flakert bloss einmal (aktualisiert) und das wars!
Währ schön wenn du da am Ball bleibst, ich kann das nähmlich nicht!
MFG
Martin S.
AW: im Makro datei von bis bearbeiten (lesen!!!)
30.07.2004 16:14:41
bis
Hallo Martin,
man sollte es halt doch immer vorher testen. Jetzt müßte es aber gehen. 

Sub TXTzuXLS()
Dim myDatei As String
Dim PfadTXT As String
Dim PfadXLS As String
PfadTXT = "C:\Dokumente und Einstellungen\XXX\400\"
PfadXLS = "C:\Dokumente und Einstellungen\XXX\400 Excel\"
On Error GoTo Ende
Application.ScreenUpdating = False
Application.DisplayAlerts = False
myDatei = Dir(PfadTXT)
Do While myDatei <> ""
Workbooks.OpenText FileName:=PfadTXT & myDatei, _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 2), Array(22, 2), Array(26, 2), Array(29, 2), Array(34, 2), Array(39, 2), _
Array(42, 2), Array(51, 2), Array(56, 2), Array(60, 2), Array(80, 2), Array(81, 2))
With ActiveWorkbook.Worksheets(1)
.Rows("1:1").Insert Shift:=xlDown
.Range("A1") = "AAA"
.Columns("B:D").Delete Shift:=xlToLeft
.Range("B1") = "BBB"
.Range("C1") = "CCC"
.Range("D1") = "DDD"
.Range("E1") = "EEE"
.Range("F1") = "FFF"
.Range("G1") = "GGG"
.Range("H1") = "HHH"
.Range("I1") = "III"
.Rows("1:1").Font.Bold = True
.Range("A1").Select
.SaveAs FileName:=PfadXLS & .Name & ".xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
.Parent.Close
End With
myDatei = Dir
Loop
Ende:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If Err > 0 Then MsgBox Error
End Sub
Gruß Uwe
Anzeige
AW: im Makro datei von bis bearbeiten (lesen!!!)
30.07.2004 18:45:49
bis
Besten Dank!
Jetzt klappt es super! Per Knopfdruck 280 Datein und 2,88 GB Daten erstellt.
Hab so lange bis der Code funktioniert hat per hand gemacht - ca. 3 Stunden Arbeit und 86 Dateien und 1 GB Daten.
ist ne deutliche erleichterung!
Und davon hab ich noch mehr!
Jedenfals allerbesten dank! Super was man alles mit excel machen kann - wenn man´s kann!!!
MFG
Martin S.
bei einer neuen sorte bewegt sich wieder nichts
30.07.2004 20:14:02
Martin
Hallo! Ich bins nochmal!
Wo ist hier schon wieder der Fehler?

Sub TXTzuXLS001()
Dim myDatei As String
Dim PfadTXT As String
Dim PfadXLS As String
PfadTXT = "C:\Dokumente und Einstellungen\Notebook\Desktop\XXX\Lieferranten\002\"
PfadXLS = "C:\Dokumente und Einstellungen\Notebook\Desktop\XXX\Lieferranten\002\"
On Error GoTo Ende
Application.ScreenUpdating = False
Application.DisplayAlerts = False
myDatei = Dir(PfadTXT)
Do While myDatei <> ""
Workbooks.OpenText Filename:=PfadTXT & myDatei, _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 9), Array(22, 9), Array(26, 9), Array(29, 2), Array(38, 2), Array(41, 2))
With ActiveWorkbook.Worksheets(1)
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Bez"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Sprach"
Range("C1").Select
ActiveCell.FormulaR1C1 = "text"
Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:="001"
Selection.AutoFilter Field:=2, Criteria1:="<>*001*", Operator:=xlAnd
Rows("4:22").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
.SaveAs Filename:=PfadXLS & .Name & ".xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
.Parent.Close
End With
myDatei = Dir
Loop
Ende:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If Err > 0 Then MsgBox Error
End Sub

Es soll aus dem ganzen Kramm mal ein WebShop für Autoteile werden.
Deine ganze Arbeit ist langsam ein gutschein wert! Was hällst davon?
MFG
Martin S.
Anzeige
AW: bei einer neuen sorte bewegt sich wieder nichts
30.07.2004 21:25:30
Uwe
Hallo Martin,
wo ist denn hier das Problem? Das einzige, was mir auffällt, ist der gleiche Pfad
für Quell- und Zieldateien. Wenn das so gewollt ist, müßte die Zeile
myDatei = Dir(PfadTXT)
in
myDatei = Dir(PfadTXT & "*.txt")
geändert werden.
Gruß Uwe
AW: bei einer neuen sorte bewegt sich wieder nichts
30.07.2004 22:18:22
Martin
Ja das ist so gewollt!
Es tut sich schon wieder nichts! Nur wieder die Aktualisierung!
bin alles mehrmals durch und habe nichts gefunden.
MFG
Martin S.
AW: bei einer neuen sorte bewegt sich wieder nichts
30.07.2004 22:37:00
Martin
hab err durch error ersetzt und msg error mit " versehen (msg "error")
Jetzt sagt die msg Box "Error"
AW: bei einer neuen sorte bewegt sich wieder nichts
30.07.2004 22:59:24
Uwe
Hallo Martin,
die Err-Zeile laß mal so. Es soll ja nur eine Meldung kommen,
wenn das Makro wegen eines Fehlers abbricht. Da ja kein Fehler
vorliegt, kann es eigentlich nur noch am falschen Pfad liegen,
so daß eben keine Dateien gefunden werden. Vergleich noch mal
genau die Pfade, z.B. Liefer(r)anten.
Gruß Uwe
Anzeige
AW: bei einer neuen sorte bewegt sich wieder nichts
30.07.2004 22:56:50
Martin
hab fehler gefunden!
liegt an der endung! txt stimmt nicht! .001 , .010 usw NICHT Fortlaufend!!!
Was kann man da machen?
MFG
Martin S.
AW: bei einer neuen sorte bewegt sich wieder nichts
30.07.2004 23:34:16
Uwe
Hallo Martin,
jetzt werden alle Dateien, die nicht die Endung ".xls" haben, eingelesen. 

Sub TXTzuXLS001()
Dim myDatei As String
Dim PfadTXT As String
Dim PfadXLS As String
PfadTXT = "C:\Dokumente und Einstellungen\Notebook\Desktop\XXX\Lieferranten\002\"
PfadXLS = "C:\Dokumente und Einstellungen\Notebook\Desktop\XXX\Lieferranten\002\"
On Error GoTo Ende
Application.ScreenUpdating = False
Application.DisplayAlerts = False
myDatei = Dir(PfadTXT)
Do While myDatei <> ""
If Right(myDatei, 4) <> ".xls" Then
Workbooks.OpenText FileName:=PfadTXT & myDatei, _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:= _
Array(Array(0, 9), Array(22, 9), Array(26, 9), Array(29, 2), Array(38, 2), Array(41, 2))
With ActiveWorkbook.Worksheets(1)
Rows("1:1").Insert Shift:=xlDown
Range("A1").FormulaR1C1 = "Bez"
Range("B1").FormulaR1C1 = "Sprach"
Range("C1").FormulaR1C1 = "text"
Cells.Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:="001"
Selection.AutoFilter Field:=2, Criteria1:="<>*001*", Operator:=xlAnd
Rows("4:22").Delete Shift:=xlUp
Selection.AutoFilter
Columns("B:B").Delete Shift:=xlToLeft
Range("A1").Select
.SaveAs FileName:=PfadXLS & .Name & ".xls", _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
.Parent.Close
End With
End If
myDatei = Dir
Loop
Ende:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If Err > 0 Then MsgBox Error
End Sub
Gruß Uwe
Anzeige
AW: bei einer neuen sorte bewegt sich wieder nichts
31.07.2004 12:17:49
Martin
Hallo!
Mit dem Code klappt es fast! bloss das alle Dateien ja 001 (+endung .001 ...) heisen.
Sodas nur eine Datei entsteht! .001 ist in dem Fall ja die endung und wird nicht zur Namensbildung verwendet!
Ich breuchte den Original Namen der zur jeweiligen datei gehört. sonst komme ich da durcheinander, weil er nicht von vorn anfängt sondern irgendwo!
MFG
Martin S.
AW: bei einer neuen sorte bewegt sich wieder nichts
31.07.2004 13:04:05
Uwe
Hallo Martin,
ändere die Zeile
.SaveAs FileName:=PfadXLS & .Name & ".xls", _
in
.SaveAs FileName:=PfadXLS & .Parent.Name & ".xls", _
Dadurch wird der Dateiname inklusive Endung übernommen.
Gruß Uwe
Anzeige
AW: bei einer neuen sorte bewegt sich wieder nichts
02.08.2004 09:29:39
Martin
Jetzt klappt es!
Danke!
MFG
Martin S.
PS. wegen gutschein! in ca. 3-4 Wochen ist mein Shop online
www.ms-webshop.de. Kannst dich den ja melden wenn du einen möchtest!
AW: im Makro datei von bis bearbeiten (lesen!!!)
30.07.2004 14:48:12
bis
Hallo Martin,
da fehlt ein Backslash beim TXT-Pfad.
So muß es aussehen:
myDatei = Dir("C:\Dokumente und Einstellungen\XXX\400\")
Gruß Uwe

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige