Mit UserformButton Exceldatei - Datensuchen
08.09.2018 16:36:52
Manfred
ich habe eine Userform in der ich mit einem Button ein Excelsheet öffne, dort einen Eintrag suche und Daten von einer bestimmten Zeile auslese und in ein Textfeld erscheinen lasse. Das funktioniert hervorragend, aber ich habe eine maschinell erstellte Exceldatei, die immer mit einem Laufzeitfehler abbricht.
Andere Dateien funktionieren mit der Prozedur.
In der Exceldatei sind insgesamt ca. 11000 Zeilen und sieht wie eine normale Exceldatei aus. Wenn ich nun alle Zeilen aus der Datei kopiere und in ein leeres Exceldokument reinkopiere und dann mit meiner Prozedur bearbeite funktioniert es.
Und als 2tes kommt mir meine Prozedur etwas kompliziert vor. Das müsste doch einfacher gehen, oder?
Hier ist der Code:
------------------
' Name des CommandButton ggf. ANPASSEN!
Private Sub CommandButton1_Click()
Dim objWB As Object, objRange As Object, bolAlreadyOpen As Boolean
Const cstrFile As String = "D:\Forum\1.xls" 'Dateiname - ANPASSEN!
Const cstrTab As String = "Tabelle1" 'Tabellenname - ANPASSEN!
On Error GoTo ErrorHandler
With Application
.ScreenUpdating = False
.EnableEvents = False
.AskToUpdateLinks = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
' TextBox1 = Textbox mit Suchbegriff - Name ggf. ANPASSEN!
If Len(Trim$(TextBox1)) Then
' TextBox2 & TextBox3 = Ausgabetextboxen - Namen ggf. ANPASSEN!
TextBox2 = "": TextBox3 = ""
For Each objWB In Application.Workbooks
If objWB.FullName = cstrFile Then bolAlreadyOpen = True: Exit For
Next
If objWB Is Nothing Then Set objWB = Workbooks.Open(cstrFile)
With objWB
Set objRange = .Sheets(cstrTab).Columns(3).Find(What:=TextBox1, LookAt:=xlWhole, _
LookIn:=xlValues, MatchCase:=False, SearchFormat:=False)
If Not objRange Is Nothing Then
TextBox2 = objRange.Offset(0, -2)
TextBox3 = objRange.Offset(0, -1)
Else
MsgBox "Suchbegriff nicht gefunden!"
End If
If Not bolAlreadyOpen Then .Close False
End With
Else
MsgBox "Suchbegriff fehlt!"
End If
ErrorHandler:
If Err.Number 0 Then
MsgBox "Fehler in UserForm1" & vbLf & vbLf & "Prozedur:" & vbTab & "CommandButton1_Click" & _
_
_
vbLf & _
"Nummer:" & vbTab & Err.Number & vbLf & "Meldung:" & vbTab & Err.Description & vbLf & _
IIf(Erl, "Zeile:" & vbTab & Erl, ""), vbExclamation, "Fehler!"
Err.Clear
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
.AskToUpdateLinks = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
Set objWB = Nothing
Set objRange = Nothing
End Sub