Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1268to1272
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
Inhaltsverzeichnis

Fehler 13

Fehler 13
Horst
Hallo Excel-Experten,
hat irgendjemand eine Ahnung, was bei folgender VBA-Prozedur zu einem "Fehler 13: Typen unverträglich" führen könnte? In 90 % der Fälle funktioniert der Code problemlos, selten bricht er jedoch mit einer Fehlermeldung ab, erstellt dann die Dateien "retrain.txt" und "text.txt", verweigert allerdings die Erstellung von "train.txt".
Wenn jemanden etwas auffallen würde, wäre super!
Gruß, Horst
Sub signalgen_one()
Dim oApp As Excel.Application, oWB_Ex As Workbook
Dim iCalc%
Dim sPath$, File_Test$, File_Train$, File_ReTrain$, File_XLX$
Dim tmpWS As Worksheet
Dim lngMaxRow&, nCount&, sString$, strInfo$
Dim F%
sPath$ = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
File_XLX = sPath & "results.xls" 'evtl. Pfad anpassen
File_Test = sPath & "test_one.txt" 'evtl. Pfad anpassen
File_Train = sPath & "train_one.txt" 'evtl. Pfad anpassen
File_ReTrain = sPath & "retrain_one.txt" 'evtl. Pfad anpassen
'Text- File löschen, evtl. Zeilen löschen wenn nicht gewünscht
If Dir(File_Test, vbNormal)  "" Then Kill File_Test
If Dir(File_Train, vbNormal)  "" Then Kill File_Train
If Dir(File_ReTrain, vbNormal)  "" Then Kill File_ReTrain
On Error GoTo ErrorHandler:
Set oApp = New Excel.Application
oApp.Visible = True 'evtl. auf True setzen, wenn der Vorgang sichbar sein soll
oApp.Workbooks.Open "C:\Programme\Signal_Pro\update\signal_db.xls", ReadOnly:=True
Set oWB_Ex = oApp.Workbooks.Open(File_XLX, True, True)
iCalc = oApp.Calculation
oApp.EnableEvents = False
oApp.Calculation = xlCalculationManual
oApp.DisplayAlerts = False
With oWB_Ex
Set tmpWS = .Sheets.Add
With .Sheets("results")
.UsedRange.AutoFilter Field:=134, Criteria1:="1"
.UsedRange.AutoFilter Field:=126, Criteria1:=" 1 Then
With Application
F = FreeFile
Open File_Test For Append As #F
sString = Join(.Transpose(.Transpose(tmpWS.UsedRange.Rows(lngMaxRow))), vbTab)
Print #F, sString
Close #F
strInfo$ = Chr(149) & " " & Mid$(File_Test, InStrRev(File_Test, "\") + 1, Len(File_Test) _
) & vbCr
lngMaxRow = lngMaxRow - 1
If lngMaxRow > 1 Then
Open File_ReTrain For Append As #F
nCount = .Max(2, lngMaxRow - 69)
For lngMaxRow = nCount To lngMaxRow
sString = Join(.Transpose(.Transpose(tmpWS.UsedRange.Rows(lngMaxRow))),  _
vbTab)
Print #F, sString
Next lngMaxRow
Close #F
strInfo$ = strInfo$ & Chr(149) & " " & Mid$(File_ReTrain, InStrRev(File_ReTrain, "\" _
) + 1, Len(File_ReTrain)) & vbCr
End If
nCount = nCount - 1
If nCount > 1 Then
Open File_Train For Append As #F
For lngMaxRow = 2 To nCount
sString = Join(.Transpose(.Transpose(tmpWS.UsedRange.Rows(lngMaxRow))),  _
vbTab)
Print #F, sString
Next lngMaxRow
Close #F
strInfo$ = strInfo$ & Chr(149) & " " & Mid$(File_Train, InStrRev(File_Train, "\") +  _
1, Len(File_Train)) & vbCr
End If
End With
End If
ErrorHandler:
If iCalc  0 Then oApp.Calculation = iCalc
oApp.Quit
Set oApp = Nothing
If Err.Number  0 Then
MsgBox Err.Description, vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
Else
MsgBox "Text- Files geschrieben!" & vbCr & vbCr & Left$(strInfo, Len(strInfo) - 1),  _
vbInformation
End If
End Sub

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Fehler 13
26.06.2012 13:15:24
guentherh
für welchen Datentyp steht das "&"?
Gruß,
Günther
AW: Fehler 13
26.06.2012 13:19:51
guentherh
& gefunden- kanns kaum sein;
in welcher Codezeile tritt der Fehler auf?
Gruß,
Günther
AW: Fehler 13
26.06.2012 17:53:27
Horst
Hallo, der Fehler tritt bei "If iCalc 0 Then oApp.Calculation = iCalc" auf, eher gegen Ende der Prozedur. Es sind sehr große Mappen, die aktualisiert und in .txt's geschrieben werden, ca. 50-300 MB.
Kann man den irgendwie abfangen?
Gruß, Horst
AW: Fehler 13
27.06.2012 08:56:34
guentherh
bei mir läuft die Zeile einwandfrei
weitere Auffälligkeiten:
bei
On Error GoTo ErrorHandler:
ist der Doppelpunkt überflüssig
vor
ErrorHandler:
ist kein exit sub also wird der errorhandler immer auch am Schluß des Programms durchlaufen.
ist es erforderlich oapp.calculation zu setzen, wenn danach oapp.quit kommt?
Anzeige
AW: Fehler 13
27.06.2012 09:21:47
Horst
Danke für die Anmerkung. Die Prozedur läuft jetzt ganz gut, lag wohl an Rechnenfehlern in den zu aktualisierenden Blättern, die den Fehler 13 auslösen noch bevor ein Error Handler zum Zug kommen kann. Der Doppelpunkt bei Error Handler kommt übrigens doppelt vor (nach end if auch), schadet aber glaube ich nicht.
Günstig wäre allerdings, wenn man nicht das gesamt Blatt kopieren würde, sondern den Spaltenbereich auf $A$:$DT$ einschränken könnte, wie gehe ich da am besten vor?
Besten dank vorab,
Horst
AW: Fehler 13
27.06.2012 09:57:07
guentherh
Hallo Horst,
normalerweise (lt. Doku) wird beim "on error" kein doppelpunkt verwendet, am Zielpunkt ist er erforderlich.
seltsamerweise funktioniert es eben auch mit Doppelpunkt in der "on error" - Zeile.
nur die Spalte:
aus
.UsedRange.copy tmpWS.Cells(1, 1)
wird
intersect( .UsedRange, .range("A:DT")).copy tmpWS.Cells(1, 1)
Gruß,
Günther
Anzeige
AW: Fehler 13
27.06.2012 12:24:42
Horst
Leider funktioniert der Intersect-Befehl in diesem Zusammenhang nicht. Error 1004: "Die Methode 'Intersect' für das Objekt '_Global' ist fehlgeschlagen". Woran liegts?
Es wird ja das gesamte Blatt zunächst gefiltert (Autofilter in Spalte 134=1), dann komplett kopiert und anschließend sollte von der Kopie nur der Bereich A:DT gespeichert werden (wie gehabt zeilenmäßig nach Datum aufgeteilt in drei verschiedenen .txt's). Wie setze ich das am besten um?
Der Doppelpunkt bei "on error" ist übrigens weg, das funktioniert problemlos.
Gruß, Horst
Sub signalgen_one()
Dim oApp As Excel.Application, oWB_Ex As Workbook
Dim iCalc%
Dim sPath$, File_Test$, File_Train$, File_ReTrain$, File_XLX$
Dim tmpWS As Worksheet
Dim lngMaxRow&, nCount&, sString$, strInfo$
Dim F%
sPath$ = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
File_XLX = sPath & "results.xls" 'evtl. Pfad anpassen
File_Test = sPath & "test_one.txt" 'evtl. Pfad anpassen
File_Train = sPath & "train_one.txt" 'evtl. Pfad anpassen
File_ReTrain = sPath & "retrain_one.txt" 'evtl. Pfad anpassen
'Text- File löschen, evtl. Zeilen löschen wenn nicht gewünscht
If Dir(File_Test, vbNormal)  "" Then Kill File_Test
If Dir(File_Train, vbNormal)  "" Then Kill File_Train
If Dir(File_ReTrain, vbNormal)  "" Then Kill File_ReTrain
On Error GoTo ErrorHandler
Set oApp = New Excel.Application
oApp.Visible = False 'evtl. auf True setzen, wenn der Vorgang sichbar sein soll
oApp.Workbooks.Open "C:\Programme\Signal_Pro\update\signal_db.xls", ReadOnly:=True
Set oWB_Ex = oApp.Workbooks.Open(File_XLX, True, True)
iCalc = oApp.Calculation
oApp.EnableEvents = False
oApp.Calculation = xlCalculationManual
oApp.DisplayAlerts = False
With oWB_Ex
Set tmpWS = .Sheets.Add
With .Sheets("results")
.UsedRange.AutoFilter Field:=134, Criteria1:="1"
.UsedRange.AutoFilter Field:=126, Criteria1:=" 1 Then
With Application
F = FreeFile
Open File_Test For Append As #F
sString = Join(.Transpose(.Transpose(tmpWS.UsedRange.Rows(lngMaxRow))), vbTab)
Print #F, sString
Close #F
strInfo$ = Chr(149) & " " & Mid$(File_Test, InStrRev(File_Test, "\") + 1, Len(File_Test) _
) & vbCr
lngMaxRow = lngMaxRow - 1
If lngMaxRow > 1 Then
Open File_ReTrain For Append As #F
nCount = .Max(2, lngMaxRow - 69)
For lngMaxRow = nCount To lngMaxRow
sString = Join(.Transpose(.Transpose(tmpWS.UsedRange.Rows(lngMaxRow))),  _
vbTab)
Print #F, sString
Next lngMaxRow
Close #F
strInfo$ = strInfo$ & Chr(149) & " " & Mid$(File_ReTrain, InStrRev(File_ReTrain, "\" _
) + 1, Len(File_ReTrain)) & vbCr
End If
nCount = nCount - 1
If nCount > 1 Then
Open File_Train For Append As #F
For lngMaxRow = 2 To nCount
sString = Join(.Transpose(.Transpose(tmpWS.UsedRange.Rows(lngMaxRow))),  _
vbTab)
Print #F, sString
Next lngMaxRow
Close #F
strInfo$ = strInfo$ & Chr(149) & " " & Mid$(File_Train, InStrRev(File_Train, "\") +  _
1, Len(File_Train)) & vbCr
End If
End With
End If
ErrorHandler:
If iCalc  0 Then oApp.Calculation = iCalc
oApp.Quit
Set oApp = Nothing
If Err.Number  0 Then
MsgBox Err.Description, vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
Else
MsgBox "Text- Files geschrieben!" & vbCr & vbCr & Left$(strInfo, Len(strInfo) - 1),  _
vbInformation
End If
End Sub

Anzeige
AW: Fehler 13
27.06.2012 12:48:47
guentherh
Der Intersect scheitert dann an der aus dem Filter resultierenden Mehrfachselektion.
Du könntest dann (von hinten durch die Brust) im neuen Blatt alle Spalten rechts von DT löschen bevor Du den Export durchführst.
Gruß,
Günther
AW: Fehler 13
27.06.2012 13:05:32
Horst
ja, das wäre eine Möglichkeit. Wie gebe ich das im Code an, damit es nicht viel zusätzlichen Rechen- und Zeitaufwand benötigt?
AW: Fehler 13
27.06.2012 13:14:23
guentherh
Range(Columns(31), Columns(Columns.Count)).Delete
AW: Fehler 13
27.06.2012 14:35:35
Horst
Hallo Guenther,
habe ich eingebaut, tut sich aber nichts, an welcher Stelle muss ich den Codeschnipsel einfügen? Es sollen von der 125. Spalte an nach rechts (bis zur 179., mehr Daten gibts in dem Blatt nicht) alle Spalten gelöscht werden, nachdem der Autofilter gesetzt ist.
Bitte kurze Info, wo ich den Columns().Delete-Befehl setzen muss.
Gruß, Horst
Sub (Makro1)
With oWB_Ex
Set tmpWS = .Sheets.Add
With .Sheets("results")
.UsedRange.AutoFilter Field:=134, Criteria1:="1"
.UsedRange.AutoFilter Field:=126, Criteria1:=" 1 Then
With Application
F = FreeFile
Open File_Test For Append As #F
sString = Join(.Transpose(.Transpose(tmpWS.UsedRange.Rows(lngMaxRow))), vbTab)
Print #F, sString
Close #F
strInfo$ = Chr(149) & " " & Mid$(File_Test, InStrRev(File_Test, "\") + 1, Len(File_Test) _
) & vbCr
lngMaxRow = lngMaxRow - 1
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige