Ich bin neu in VBA und hoffe auf etwas Hilfe beim Implementieren einer benutzerdefinierten Funktion. Ich würde wirklich jede Hilfe schätzen!Excel und VBA Crashing Midway Through Makro
Kontext: Ich versuche, einen Stapel von Textdateien mit fester Breite in separate Excel-Arbeitsmappen zu importieren. Die Textdateien haben alle dieselben Felder und dasselbe Format. Ich kenne die Länge jedes Feldes. Derzeit versuche ich, meinen VBA-Code für eine einzelne Textdatei zu verwenden.
Problem: Da ich neu bei VBA bin, suchte ich nach vorhandenen Code. Ich habe Chip Pearson's ImportFixedWidth function, edited one error found by another StackOverflow user gefunden und habe seitdem versucht, meine TestImport-Funktion (siehe unten) zu implementieren. (* Beachten Sie, dass das ... ist nur aus Gründen der Kürze -. Nicht tatsächlich im Code enthalten)
Sub TestImport()
Dim L As Long
L = ImportFixedWidth("/Users/gitanjali/Desktop/CAC06075test.txt", _
Range("A1"), _
False, _
vbNullString, _
"1,5|2,45|3,3|4,45|5,45|6,45|7,60|8,15|9,11|10,60| _
11,60|12,10|13,5|14,5|15,3|16,3|17,3|18,3|19,11|20,10|
...190,250|191,250")
End Sub
Siehe ImportFixedWidth Funktion am Ende dieses Beitrags.
Ich habe dann versucht, das Makro innerhalb der Arbeitsmappe auszuführen, aber es stürzt VBA und Excel jedes Mal ab. Das erste Feld wird in die offene Arbeitsmappe importiert (nicht die anderen 190), aber das Programm reagiert nicht mehr und muss beendet werden.
Debugging: Der Code wird kompiliert. Ich bekomme keine Fehler, wenn ich den TestImport- oder ImportFixedWidth-Code durchtrete. Ich habe versucht, das Makro sowohl auf einem Mac als auch auf einem Windows-PC auszuführen (es stürzt bei beiden ab). Und das erste Feld wird korrekt importiert, bevor das Programm abstürzt, also bin ich mir nicht sicher, was das Problem ist.
Frage: ich ratlos bin für die nächsten Schritte in Bezug auf die Fehlersuche. Gibt es offensichtliche Fehler in meiner Implementierung? Was wäre mein nächster logischer Debugging-Schritt?
Function ImportFixedWidth(FileName As String, _
StartCell As Range, _
IgnoreBlankLines As Boolean, _
SkipLinesBeginningWith As String, _
ByVal FieldSpecs As String) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ImportFixedWidth
' By Chip Pearson, [email protected] www.cpearson.com
' Date: 27-August-2011
' Compatible with 64-bit platforms.
'
' This function imports text from a fixed field width file.
' FileName is the name of the file to import. StartCell is
' the cell in which the import is to begin. IgnoreBlankLines
' indicates what to do with empty lines in the text file. If
' IgnoreBlankLines is False, an empty row will appear in the
' worksheet. If IgnoreBlankLines is True, no empty row will
' appear in the worksheet. SkipLinesBeginingWith indicates
' what character, if any, at the begining of the line indicates
' that the line should not be imported, such as fpr providing for
' comments within the text file. FieldSpecs indicates how to
' map the data into cells. It is a string of the format:
' start,length|start,length|start,length...
' where each 'start' is the character position of the field
' in the text line and each 'length' is the length of the field.
' For example, if FieldSpecs is
' 1,8|9,3|12,5
' indicates the first field starting in position 1 for a
' length of 8, the second field starts in position 9 for a
' length of 3, and finally a field beginning in position 12
' for a length of 5. Fields can be in any order and may
' overlap.
' You can specify a number format for the field which will
' be applied to the worksheet cell. This format should not
' be in quotes and should follow the length element. For example,
' 2,8|9,3,@|12,8,dddd dd-mmm-yyyy
' This specifies that no formatting will be applied to column 2,
' the Text (literal) format will be applied to column 9, and
' the format 'dddd dd-mmm-yyyy' will be applied to column 12.
'
' The function calls ImportThisLine, which should return
' True to import the text from the file, or False to skip
' the current line.
' This function returns the number of records imported if
' successful or -1 if an error occurred.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FINdx As Long
Dim C As Long
Dim R As Range
Dim FNum As Integer
Dim S As String
Dim RecCount As Long
Dim FieldInfos() As String
Dim FInfo() As String
Dim N As Long
Dim T As String
Dim B As Boolean
Application.EnableCancelKey = xlInterrupt
On Error GoTo EndOfFunction:
If Dir(FileName, vbNormal) = vbNullString Then
' file not found
ImportFixedWidth = -1
Exit Function
End If
If Len(FieldSpecs) < 3 Then
' invalid FieldSpecs
ImportFixedWidth = -1
Exit Function
End If
If StartCell Is Nothing Then
ImportFixedWidth = -1
Exit Function
End If
Set R = StartCell(1, 1)
C = R.Column
FNum = FreeFile
Open FileName For Input Access Read As #FNum
' get rid of any spaces
FieldSpecs = Replace(FieldSpecs, Space(1), vbNullString)
' omit double pipes ||
N = InStr(1, FieldSpecs, "||", vbBinaryCompare)
Do Until N = 0
FieldSpecs = Replace(FieldSpecs, "||", "|")
N = InStr(1, FieldSpecs, "||", vbBinaryCompare)
Loop
' omit double commas
N = InStr(1, FieldSpecs, ",,", vbBinaryCompare)
Do Until N = 0
FieldSpecs = Replace(FieldSpecs, ",,", ",")
N = InStr(1, FieldSpecs, ",,", vbBinaryCompare)
Loop
' get rid of leading and trailing | characters, if necessary
If StrComp(Left(FieldSpecs, 1), "|", vbBinaryCompare) = 0 Then
FieldSpecs = Mid(FieldSpecs, 2)
End If
If StrComp(Right(FieldSpecs, 1), "|", vbBinaryCompare) = 0 Then
FieldSpecs = Left(FieldSpecs, Len(FieldSpecs) - 1)
End If
Do
' read the file
Line Input #FNum, S
If SkipLinesBeginningWith <> vbNullString And _
StrComp(Left(Trim(S), Len(SkipLinesBeginningWith)), _
SkipLinesBeginningWith, vbTextCompare) Then
If Len(S) = 0 Then
If IgnoreBlankLines = False Then
Set R = R(2, 1)
Else
' do nothing
End If
Else
' allow code to change the FieldSpecs values
If FieldSpecs = vbNullString Then
' FieldSpecs is empty. Do nothing, don't import.
Else
If ImportThisLine(S) = True Then
FieldInfos = Split(FieldSpecs, "|")
C = R.Column
For FINdx = LBound(FieldInfos) To UBound(FieldInfos)
FInfo = Split(FieldInfos(FINdx), ",")
R.EntireRow.Cells(1, C).Value = Mid(S, CLng(FInfo(0)), CLng(FInfo(1)))
C = C + 1
Next FINdx
RecCount = RecCount + 1
End If
Set R = R(2, 1)
End If
End If
Else
' no skip first char
End If
Loop Until EOF(FNum)
EndOfFunction:
If Err.Number = 0 Then
ImportFixedWidth = RecCount
Else
ImportFixedWidth = -1
End If
Close #FNum
End Function
Private Function ImportThisLine(S As String) As Boolean
Dim N As Long
Dim NoImportWords As Variant
Dim T As String
Dim L As Long
NoImportWords = Array("page", "product", "xyz")
For N = LBound(NoImportWords) To UBound(NoImportWords)
T = NoImportWords(N)
L = Len(T)
If StrComp(Left(S, L), T, vbTextCompare) = 0 Then
ImportThisLine = False
Exit Function
End If
Next N
ImportThisLine = True
End Function
Wie viele Felder? Es kann einfacher sein, den Befehl string parse() zu verwenden – jsotola