Hi, ich habe mal wieder ein Problemchen, bei dem ich wohl den Wald vor lauter Bäumen nicht sehe:
Ich will diesmal mit der VBA-Funktion VLOOKUP bestimmte Daten von einem Sheet extrahieren:
Option Explicit
Public file As Variant 'Dateiname der Datei, auf die sich die Suche bezieht
Public stock As Excel.Workbook 'Initialisierung des Objektverweises für
' Zieldatei
Public BOM As Excel.Workbook 'Initialisierung des Objektverweises für diese
' Datei
Sub insertData()
Dim nLastRowStock As Long 'Enthält die letzte Zeile mit Daten in der
' Zieldatei (Für noch nicht implementierte Iteration)
Dim nLastRowBom As Long 'Selbiges für lokale Datei
Dim nColStock As Integer 'Spalte für Bestimmung der letzten Zeile in
' Zieldatei
Dim nColBom As Integer 'selbiges für lokale Datei
Dim bomRange As range 'Range in der sich der Suchbegriff befindet
Dim stockRange As range 'Range in der Gesucht werden soll
Set stock = ThisWorkbook 'Definition des Verweises durch lokale Datei
file = Application.GetOpenFilename("Excel Sheets(*.xls), *.xls", 1, "Open" & _
"BOM", "") 'Pfad der Zieldatei bestimmen
Set BOM = Workbooks.Open(file) 'Definition des Verweises durch Zieldatei
nColStock = 2
nColBom = 2
With BOM.Worksheets(1) 'Feststellen der letzten Zeile der Spalte B mit
' Daten in Zieldatei
If Application.WorksheetFunction.CountA(.Columns(nColBom).EntireColumn) _
> 0 Then
If Len(.Cells(.Rows.Count, nColBom).Value) = 0 Then
nLastRowBom = .Cells(.Rows.Count, nColBom).End(xlUp).Row
Else
nLastRowBom = .Rows.Count
End If
End If
End With
With stock.Worksheets(1) 'Feststellen der letzten Zeile der Spalte B mit
' Daten in lokaler Datei
If Application.WorksheetFunction.CountA(.Columns( _
nColStock).EntireColumn) > 0 Then
If Len(.Cells(.Rows.Count, nColStock).Value) = 0 Then
nLastRowStock = .Cells(.Rows.Count, nColStock).End(xlUp).Row
Else
nLastRowStock = .Rows.Count
End If
End If
End With
bomRange = BOM.Worksheets(1).Cells(15, 2) '<==== Ab dieser Zeile komm ich
' nicht Voran
stockRange = stock.Worksheets(1).range(Cells(3, 1), Cells(nColBom, 1)) _
'<==== Wenn "On Error Resume Next" gesetzt ist, wird auch dise Zeile
' nicht ausgeführt
BOM.Worksheets(1).Cells(15, 28) = Application.WorksheetFunction.VLookup( _
bomRange, stockRange, 7, False) 'Hier wird das Suchergebnis in eine Zelle
' der lokalen Datei gespeichert
End Sub Für mich sieht das alles solide aus... Findet ihr den Fehler?
Danke schonmal im Voraus  |