Fehler 1004 bei Schreiben in Zelle

Option Explicit Option Base 1 Sub Vornamen() Dim S As String, Zei As Long, Satz() As String, FF As Integer, Z As Long Dim F As Integer, Zeichencode As Integer, Laenge As Long 'On Error Resume Next On Error GoTo Fehler FF = FreeFile Open CurDir & "\kwVornamen.txt" For Input As #FF While Not EOF(FF) Line Input #FF, S ' FehlerZeile = 498 , Satzlaenge = 41832 'Input #FF, S ' FehlerZeile = 549, Satzlaenge = 41578 Zei = Zei + 1 'If Zei = 1001 Then GoTo Ende ReDim Preserve Satz(Zei) Satz(Zei) = S Application.StatusBar = Zei Wend 'MsgBox Zei 'Exit Sub Ende: Close #FF Application.ScreenUpdating = False For Z = 1 To Zei Laenge = Laenge + Len(Satz(Z)) Cells(Z, 1) = Satz(Z) ' Fehler 1004 bei Z = 498 bzw Z = 549 Next Z Fehler: Application.ScreenUpdating = True If Err.Number 0 Then MsgBox "zeile " & Z & " Länge= " & Laenge & Chr(13) & Err.Number & Chr(13) & Err.Description For F = 1 To Len(Satz(Z)) Zeichencode = Asc(Mid(Satz(Z - 1), F, 1)) 'Zeichencode = AscW(Mid(Satz(Z - 1), F, 1)) If Zeichencode 256 Then MsgBox Zeichencode Next F End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Rainer,
:::Bei "On Error..." wird der zweite Fehler ausgelöst, weil da vermutlich in der ersten Schleife was schiefgeht.
Nein, die erste Schleife wird problemlos durchlaufen, wenn ich hier einen Haltepunkt setze




For Z = 1 To Zei
Laenge = Laenge + Len(Satz(Z))
Cells(Z, 1) = Satz(Z)          ' Fehler 1004 bei Z = 498 bzw Z = 549
Next Z

so wird er angesprungen, der Fehle kommt erst bei Z= 498/549
:::Überprüf mal hier
Application.ScreenUpdating = False
If Zei Ubound(Satz()) then Msgbox "Alarm"
Muß Ich noch machen.
:::Was ich höchst unnatürlich finde ist, dass die "Satzlaenge = 41832" aufweist.
:::Was liest du denn da ein ?
Ach, vergiss das, war mein (w)irrer Gedanke daß da eine Variable ihren Zahlenberich überschritten hätte, oder irgendwie die 64KB Grenze oder was es da gibt überschritten hätte.
:::Line Input immer wenn Kommas im Text vorkommen, sonst wird der Text in der Zeile nach dem Komma abgeschnitten.
Aha, danke.
:::Der ASCII Zeichensatz unterstützt NUR 255 Zeichen (Zeichencode > 256)
Okay, mein Lapsus.
:::Als letztes Zeichen müsste eigentlich eine 10 oder 13 auftauchen ( MsgBox Right(Satz,1) )
Nein, nach dem Einlesen, was ja chr(10) und chr(13) auswertet sind in Satz diese Zeichen nicht mehr vorhanden *denk*
Ich habe jetzt an dem Code den ich hier zeigte nicht weiter getestet warum da der Fehler kommt. Ich habe das "On Error..." entfernt und den Code weiterentwickelt um diese Text-datei auszulesen.
Und es funktioniert mit dem nachfolgenden Code.
Insofern ist dieser Thread "erledigt" und ich danke dir für deine Mühen. Aus meinem grundsätzlichem Interesse heraus werde ich noch wie von dir vorgeschlagen
Application.ScreenUpdating = False
If Zei Ubound(Satz()) then Msgbox "Alarm"
einbauen, und schauen was dann passiert. Wenn dann nicht ersichtlich wird wodran der Fehler liegt dnn ist es halt so:-(
Auch aus Zeitgründen konzentriere ich mich dann lieber darauf wie ich diese mistige Textdatei sso einlese, daß sie brauchbar wird um aufgrund einer vorgegeben Tabelle und darin aufgrund des Vornamens die entsprechende Anrede Frau/Herr rauszufinden, da ist noch viel zu tun.
Danke dir como siempre
Gruß
Reinhard


Option Explicit
Public S As String, FF As Integer
Sub Vornamen()
Dim Zei As Long, Satz() As String, Z As Long
Dim F As Integer, Zeichencode As Integer, Laenge As Long
'On Error Resume Next
'On Error GoTo Fehler
Worksheets("Tabelle1").UsedRange.ClearContents
Worksheets("Tabelle2").UsedRange.ClearContents
Worksheets("Tabelle3").UsedRange.ClearContents
FF = FreeFile
Open CurDir & "\Vornamen.txt" For Input As #FF
Call Ueberspringen("256")
Call Ersetzungen("382")
Call Ueberspringen("Great Britain")
Call Laender("other countries")
Call Ueberspringen("Aad")
ReDim Preserve Satz(Zei)
Satz(Zei) = S
While Not EOF(FF)
Line Input #FF, S
Zei = Zei + 1
'If Zei = 1001 Then GoTo Ende
ReDim Preserve Satz(Zei)
Satz(Zei) = S
Wend
Ende:
Close #FF
With Worksheets("Tabelle1")
Application.ScreenUpdating = False
For Z = 0 To Zei - 1
Laenge = Laenge + Len(Satz(Z))
.Cells(Z + 1, 1) = Left(Satz(Z), 1)       ' Fehler 1004 bei Z = 489
.Cells(Z + 1, 2) = Mid(Satz(Z), 4)
Next Z
End With
Fehler:
Application.ScreenUpdating = True
'If Err.Number  0 Then
'   MsgBox "zeile " & Z & " Länge= " & Laenge & Chr(13) & Err.Number & Chr(13) & Err. _
Description
'   For F = 1 To Len(Satz(Z))
'      Zeichencode = Asc(Mid(Satz(Z - 1), F, 1))
'      'Zeichencode = AscW(Mid(Satz(Z - 1), F, 1))
'      If Zeichencode  256 Then MsgBox Zeichencode
'   Next F
'End If
End Sub
Sub Ueberspringen(ByVal Bis As String)
Do
Line Input #FF, S
Loop While (InStr(S, Bis) = 0)
End Sub
Sub Laender(ByVal Bis As String)
Dim Zei As Long
With Worksheets("Tabelle3")
.Cells(1, 1) = Trim(Replace(Replace(S, "#", ""), "$", ""))
Line Input #FF, S
.Cells(1, 2) = InStr(S, Chr(124))
Line Input #FF, S
Zei = 1
Do
Line Input #FF, S
Zei = Zei + 1
.Cells(Zei, 1) = Trim(Replace(Replace(S, "#", ""), "$", ""))
Line Input #FF, S
.Cells(Zei, 2) = InStr(S, Chr(124))
Line Input #FF, S
Loop While .Cells(Zei - 1, 1)  Bis
Rows(Zei - 1).ClearContents
End With
End Sub
Sub Ersetzungen(ByVal Bis As String)
Dim Zei As Long
With Worksheets("Tabelle2")
.Cells(1, 1) = Mid(S, 6, 3)
.Cells(1, 2) = Mid(S, InStr(S, "") - InStr(S, "", "")
Zei = 1
Do
Line Input #FF, S
Zei = Zei + 1
.Cells(Zei, 1) = Mid(S, 6, 3)
.Cells(Zei, 2) = Mid(S, InStr(S, "") - InStr(S, "", "")
Loop While (InStr(S, Bis) = 0)
.Columns(2).TextToColumns Destination:=.Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Space:=True, _
FieldInfo:=Array(1, 1)
.Columns(3).Delete
.Columns(4).Delete
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Fehler 1004 bei Schreiben in Zelle

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Fehler 1004 bei Schreiben in Zelle

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread