Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
368to372
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
368to372
368to372
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Problem mit VBA

Problem mit VBA
27.01.2004 12:53:38
Thorsten
Hi (mal wieder)
Fast fertiges Makro. Ich habe nur folgendes Problem. Ich importiere ANSI Dateien und filter Sie nach einem Kriterium (siehe Code). Er macht das zwar auch aber nur (richtig) bis zu einer bestimmten Anzahl von Dateien. Bei dem Rest, schreibt er mir nicht mehr den Namen der Datei in Feld "G". Das ist aber das wichitgste, damit ich, für mein Beispiel, eine Tour ablesen kann. Ich muss ca. 470 Stück importieren lassen. Ich lade gleich mal eine hoch, damit man sich das vorstellen kann.
Kann das Problem mit der Kapazität von Excel zutun haben? Zeilenbegrenzung oder ähnliches.

Sub TextImport()
Application.DisplayAlerts = False
Dim iRow As Integer, iCol As Integer, i As Integer, k As Integer, l As Integer
Dim sFile As String, sTxt As String, sTour As String
Dim datei As String, j As String
Dim rng As Range
Dim filter As String
filter = InputBox("Filterkriterium:")
If filter = "" Then Exit 

Sub 'Makro verlassen wenn kein
'Kriterium angegeben
iRow = 1
iCol = 1
datei = Dir("C:\Test\*.ans")
Do While datei <> ""
sFile = "C:\Test\" + datei
sTour = sFile
sTour = Right(sTour, 9)
On Error Resume Next
Close
Open sFile For Input As #1
Do Until EOF(1)
Line Input #1, sTxt
Do While InStr(sTxt, "|")
Cells(iRow, iCol).Value = Left(sTxt, InStr(sTxt, "|") - 1)
sTxt = Right(sTxt, Len(sTxt) - InStr(sTxt, "|"))
iCol = iCol + 1
Loop
Cells(iRow, iCol).Value = sTxt
Cells(iRow, 6).Value = Replace(sTour, ".ans", "")
iRow = iRow + 1
iCol = 1
Loop
Close
Application.ScreenUpdating = False
Sheets("Tabelle1").Select
With Range("A1")
filter = filter + "*"
.AutoFilter Field:=4, Criteria1:=filter
.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("Ergebnis").Range("A1")
End With
Sheets("Ergebnis").Range("A:C,E:j").Delete
Sheets("Tabelle1").Range("f:f").Select
Selection.Copy Sheets("Ergebnis").Range("F1")
Sheets("Ergebnis").Range("A:A").TextToColumns Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1))
datei = Dir
Sheets("Ergebnis").Cells(1, 1).Value = "M&G Tabelle"
Sheets("Ergebnis").Cells(1, 2).Value = "Name"
Sheets("Ergebnis").Cells(1, 3).Value = "PLZ"
Sheets("Ergebnis").Cells(1, 4).Value = "Ort"
Sheets("Ergebnis").Cells(1, 5).Value = "Diff. km"
Sheets("Ergebnis").Cells(1, 6).Value = "neue Tour"
Sheets("Ergebnis").Columns(3).Insert xlToRight
Sheets("Ergebnis").Cells(1, 3).Value = "Strasse"
Loop
End Sub

Vielleicht weiß jemand Rat.
Gruß Thorsten

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Problem mit VBA
27.01.2004 13:08:17
LotharR
Hi Thorsten,
ich hab zwar in deinen Schleifen jetzt nicht nachgerechnet, aber bei 470 files wird doch recht schnell die Zeilenanzahl aller Zeilen von 32767 erreicht, und da du das als Integer dimensioniert hast, liegt es möglicherweise daran. Versuch mal mit DIM xx as Long.
Gruss
Lothar
AW: Problem mit VBA
27.01.2004 13:25:16
Thorsten
Hallo.
Dank Dir.
Werde es mal versuchen
AW: Problem mit VBA
27.01.2004 13:10:01
Alex K.
Hallo Thorsten,
ich würde erst einmal nicht die Dateinummer #1 verwenden, sondern die nächst freie Dateinummer mit "FreeFile" ermitteln.

Dim fileno   As Integer
fileno = FreeFile
Open sFile For Input As #fileno

Dann nehme mal die Anweisung "On Error resume next" heraus, dann siehst, wo das Makro hängen bleibt.
Anzeige
AW: Problem mit VBA
27.01.2004 13:24:40
Thorsten
Hi.
Danke für die Antwort.
Ich probier es gleich mal aus
Hat sich nix getan. :(
27.01.2004 14:46:29
Thorsten
Hilfe.
Ich verzweifel langsam.
Nichts hat geholfen....
AW: Hat sich nix getan. :(
27.01.2004 14:53:42
Alex K.
Hallo Thorsten,
kann vielleicht auch am "Dir()" Befehl liegen. Lass mal einen Zähler für die Dateien mitlaufen und bei Zähler=250 setzte den Dir-Befehl neu auf. Ist sicher schwierig, da du nicht weißt, welche Dateien bis dahin gelesen wurden bzw. welche Dateien noch verarbeitet werden müssen. Also du könntest zwei Verzeichnisse erstellen und die Dateien aufteilen. Oder du kannst jede Datei nach der Verarbeitung umbennen und dann mit Muster die noch ausstehenden Dateien suchen.
Anzeige
AW: Hat sich nix getan. :(
27.01.2004 15:11:32
Thorsten
Ich glaube, ich weiß, woran das liegt. Ich habe einen Fall, in dem der Name des Eintrages in sich ein "," enthält. D.h. der Text wird in Spatlten geschrieben und es wir ein "," zuviel getrennt. Leider weiß ich nicht, wie man das beheben kann. Weißt Du etwas?
AW: Hat sich nix getan. :(
27.01.2004 15:36:06
Alex K.
Hallo Thorsten,
was passiert in diesem Fall? Kommt ein Fehler, wenn ja, kannst du diesen ja abfangen:

On Error Resume Next
...TextToColumns ...
If Err.Number <> 0 Then
Err.Clear
MsgBox "Datei '" & datei & "' enthält nicht importierbare Daten."
end if

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige