Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
724to728
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
724to728
724to728
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Fehlerhaftes Script

Fehlerhaftes Script
03.02.2006 14:30:08
sheila-ann
Hallo,
ich nutze folgendes Script was allerdings irgendwo einen kleinen Fehler hat. Das Script soll folgendes tun:
"Liste1.xls" mit "Liste2.xls" vergleichen und übereinstimmungen in ein neues Blatt exportieren (und rot markieren)
Das Problem ist aber jetzt: Sobald in "Liste1.xls" mehr als 1 Tabellenblatt vorhanden ist, erscheint folgender Fehler:
"Laufzeitfehler '91'. "Objektvariable oder With-Blockvariable nicht festgelegt.
Sieht jemand den Fehler?
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Declare

Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare 

Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public sPath As String
Public SuchArt
Public Begriff As String
Dim xZeile As Long
Dim i As Long
Dim sFile As String
Dim wbk
Dim wbkx
Dim wbky
Dim wbk1
Dim aRow As Long

Sub DateienOeffnen()
Dim arr As Variant
Dim iCounter As Integer
Dim bln As Boolean
Application.ScreenUpdating = False
bln = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Set wbkx = Workbooks("Suchmaske.xla").Worksheets("Suchergebnisse")
sFile = wbkx.Range("A1").Value
On Error GoTo Datei_oeffnen
Windows(sFile).Activate
On Error GoTo 0
Datei_oeffnen:
Workbooks.Open sFile, UpdateLinks:=False
Sheets(1).Activate
Set wbky = ActiveWorkbook.ActiveSheet
aRow = [A65536].End(xlUp).Row
For i = 1 To aRow
wbkx.Cells(i, 2) = wbky.Cells(i, 1)
Next
ActiveWorkbook.Close False
Workbooks.Add
Set wbk1 = ActiveWorkbook.ActiveSheet
i = 1
arr = FileArray(sPath, "*.xls")
For iCounter = 1 To UBound(arr)
sFile = arr(iCounter)
If WkbExists(sFile) Then
Workbooks(sFile).Activate
xOffen = True
Else
Application.StatusBar = "Durchsuche Datei " & _
arr(iCounter) & "..."
Workbooks.Open sPath & sFile, UpdateLinks:=False
End If
Suche
If xOffen = False Then Workbooks(sFile).Close False
xOffen = False
Next iCounter
Application.StatusBar = False
Application.DisplayStatusBar = bln
Application.ScreenUpdating = True
End Sub


Function FileArray(sPath As String, sPattern As String)
Dim arrFiles()
Dim iCounter As Integer
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sFile = Dir(sPath & sPattern)
Do While sFile <> ""
iCounter = iCounter + 1
ReDim Preserve arrFiles(1 To iCounter)
arrFiles(iCounter) = sFile
sFile = Dir()
Loop
FileArray = arrFiles
End Function


Function WkbExists(sFile As String) As Boolean
Dim wkb As Object
On Error Resume Next
Set wkb = Workbooks(sFile)
If Err = 0 And Not wkb Is Nothing Then
WkbExists = True
End If
On Error GoTo 0
End Function


Function GetDirectory(Optional Msg As String) As String
Dim bInfo As BROWSEINFO
Dim Path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
Path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal Path)
If r Then
pos = InStr(Path, Chr$(0))
GetDirectory = Left(Path, pos - 1)
Else
GetDirectory = ""
End If
End Function


Sub Suche()
Dim wks As Worksheet
Dim rng As Range
Dim sZeile As Variant, sFind As String
Dim sSpalte
For Each wks In Worksheets
For k = 1 To aRow
Begriff = wbkx.Range("B" & k).Value
Set rng = wks.Cells.Find(Begriff, , , SuchArt)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
sSpalte = rng.Column
Rows(rng.Row).Copy wbk1.Rows(i)
wbk1.Cells(i, sSpalte).Interior.ColorIndex = 3
i = i + 1
Set rng = Cells.FindNext(after:=rng.Offset(1, 0))
If rng.Address = sAddress Then Exit Do
Loop
End If
Next k
Next wks
End Sub


Sub Starten()
UserForm1.Show
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Fehlerhaftes Script
03.02.2006 18:54:14
ChrisL
Hallo
So kann dir schlecht jemand helfen (langer unübersichtlicher Code). Einige Tips:
1. Ein Beispiel für die von dir genannte Fehlermeldung:

Sub t()
Dim WS As Worksheet
MsgBox WS.Name
End Sub

Du sprichst die Variable WS an, aber sie enthält nichts. So würde es funktionieren:

Sub t()
Dim WS As Worksheet
Set WS = Worksheets("Tabelle1")
MsgBox WS.Name
End Sub

Der Fehler könnte also z.B. entstehen, wenn du diese Zeile ansprichst:
Begriff = wbkx.Range("B" & k).Value
Wird wbkx vorher nicht festgelegt, bekommst du deinen Fehler.
2. Schreib Option Explicit oben hin. Dies zwingt dich dazu, alle Variablen zu deklarieren. Eine richtige Deklaration der Variablen ist wichtig und steht möglicherweise mit deinem Fehler in Zusammenhang. Schau dir folgendes Kapitel an:
http://xlfaq.herber.de/xlbasics/main_var.htm
3. Versuche auf Public (globale Variablen) zu verzichten. D.h. deklariere deine Variablen wenn möglich innerhalb deiner Funktionen und Prozeduren (vielleicht nicht immer möglich).
Gruss
Chris
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige