Office: SVerweis als VBA über mehrere Tabellenblätter einer externen Datei

soweitsogut · 26. Oktober 2013

Hallo zusammen,

immer wieder muß ich artikel prüfen, ob diese bereits ein Enddatum für Service haben.

Mittels Sverweis würde ich es machen wenn es eine kleine Datei wäre, und wenn nur 1 Tabelle betroffen wäre.
Das sähe also so aus:
=SVERWEIS(A1;[EoL.xls]sheet1!$A:$T;20;FALSCH)

Die Herstellertabelle in der dies zu prüfen ist hat aber mittlerweile 4 Tabellenblätter mit je knapp 60.000 Zeilen. (113 MB)

Daher möchte ich eine Excel Datei (EoLEingabeCheck.xls)machen, die ich nur in Spalte A mit Artikel befüllen möchte, und die per Markro zu prüfen sind.

Somit sollte ich einmal die Tabelle "EoL.xls" öffnen (falls nicht bereits auf).
Dann sollen für alle befüllten Zellen (nur von Spalte A) in EoLEingabeCheck.xls die Werte in der "EoL.xls" gesucht werden.
Wenn etwas gefunden wird, soll er in Spaltze B meiner EoLEingabeCheck.xls den Wert aus EoL.xls schreiben, der 20 Spalten weiter Rechts gefunden wurde.
Wiegesagt bezieht es sich auf mehrere Tabellenblätter die zu prüfen sind.

Aktuell bekomm ich Fehlermeldung ArgumentTyp ByRef unverträglich, aber wie Ihr seht sind in meinem Code wohl noch weitere Schlaglöcher.

Wer kann mir da helfen. Vielleicht bin ich da auch völlig auf dem falschen Weg?

soweitsogut

Code:

Public Sub pruefen()
'
' pruefen Makro
'
' Tastenkombination: Strg+t
'

Dim Zelle As Range
Application.ScreenUpdating = False

On Error GoTo aufhoeren

dateiaufruf

For Each Zelle In Artcheck.Range("A2:A10")
Zelle.Offset(0, 1).Value = "EoL"
suchen wb, Artikel

Next

Application.ScreenUpdating = True
Exit Sub
aufhoeren:
End Sub

Public Sub dateiaufruf()
Public dateiname As String
Public wb As Workbook
On Error GoTo Fehler
Set wb = Workbooks.Open(Filename:="EoL.xls")
Exit Sub
Fehler:
On Error GoTo 0
dateiname = Application.GetOpenFilename(Title:="Datei auswählen")

If Left(dateiname, 6) "Falsch" Then
Set wb = Workbooks.Open(dateiname)
End If
End Sub

Public Sub suchen(wb As Workbook, Artikel As String)
Dim rg As Range

Set rg = wb.ActiveSheet.Columns("A:A").Find(What:=Artikel)
If Not rg Is Nothing Then
rg.Activate
MsgBox "gefunden"
' schreibe wert 20 Zellen rechts von gefundener Zelle in die zelle rechts der überprüften Artikelnummer
Else
MsgBox "Kontrolle: nichts gefunden"

End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

soweitsogut · 6. November 2013

Guten Morgen,
vermutlich war meine Fragestellung für viele zu banal um eine Tipp zu geben :-)
Mittlerweile habe ich durch viele Versuche und Recherche selbst eine Lösung gefunden, die ich natürlich gern zur Verfügung stelle.

soweitsogut

Code:

Public dateiname As String
Public merken As Integer

Sub pruefen()
'
' pruefen Makro
'
' Tastenkombination: Strg+t
'
Dim wsCheck As Worksheet
Dim wbEoL As Workbook
Dim Tabelle As Worksheet
Dim Zelle As Range
Dim Treffer As Range
Dim rg As Range

If merken 1 Then MsgBox "Achtung! Wegen der Größe der Datei kann der Vorgang einige minuten dauern."
Application.ScreenUpdating = False
Set wsCheck = ActiveSheet
wsCheck.Unprotect
For i = 2 To 14
wsCheck.Columns(i).ClearContents
Next i
If merken = 1 Then
If MsgBox("Letzte Datei für EoL wieder verwenden? Nein, wenn neu ausgewählt werden soll", vbYesNo) vbYes Then dateiname = ""
End If
While dateiname = ""
dateiname = Application.GetOpenFilename(Title:="Datei auswählen")
If dateiname = "Falsch" Then dateiname = ""
Wend
Set wbEoL = Workbooks.Open(dateiname)
merken = 1
For Each Zelle In wsCheck.Range("A1:A" & Range("A1000").End(xlUp).Row)
For Each Tabelle In wbEoL.Worksheets
On Error Resume Next
Set Treffer = Tabelle.Range("A:A").Find(Zelle.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not Treffer Is Nothing Then
For i = 1 To 12
Zelle.Offset(0, i) = Treffer.Offset(0, 20 - i).Value
Next i
End If
Next Tabelle
Next Zelle
wbEoL.Close SaveChanges:=False
wsCheck.Activate
wsCheck.Protect
Application.ScreenUpdating = True

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: SVerweis als VBA über mehrere Tabellenblätter einer externen Datei

SVerweis als VBA über mehrere Tabellenblätter einer externen Datei

SVerweis als VBA über mehrere Tabellenblätter einer externen Datei

SVerweis als VBA über mehrere Tabellenblätter einer externen Datei - Similar Threads - SVerweis VBA Tabellenblätter

VBA SVerweis? / VBA neues Worksheet erstellen

Primärschlüssel/Fremdschlüssel aus 2.Tabelle automatisch einfügen

Excel VBA Userform Daten aus Tabelle Auslesen "sverweis"

Copy and Paste unter bestimmten Bedingungen VBA

Kundennummer in Sverweis Zelle fortlaufend einfügen und drucken (VBA)

[VBA] Makro SVERWEIS auf andere Arbeitsmappe

VBA + SVERWEIS kombinieren?