AW: per Vlookup Daten aus externer Datei übertragen
31.01.2019 14:22:44
Cevren
Nicht elegant aber eine Lösung:
Public Function RC1DateiEinlesen() As String
Dim oFileDialog As FileDialog
Dim DestinationRange As Range
Dim RC1Dateiname As String
Dim myLookupValue As String
Dim myFirstColumn As Long
Dim myLastColumn As Long
Dim myColumnIndex As Long
Dim myFirstRow As Long
Dim myLastRow As Long
Dim myVLookupResult As Currency
Set oFileDialog = Application.FileDialog(msoFileDialogFilePicker)
Set DestinationRange = Range("D5")
Dim myTableArray As Range
myLookupValue = "im Mittel"
myFirstColumn = 1
myLastColumn = 26
myColumnIndex = 4
myFirstRow = 1
myLastRow = 90
With oFileDialog
.Title = "Datei Einlesen"
.Filters.Add "XML-Dateien", "*.xml", 1
.ButtonName = "Einlesen"
If .Show = -1 Then RC1DateiEinl = .SelectedItems(1)
If RC1DateiEinl "" Then
Workbooks.Open RC1DateiEinl
RC1Dateiname = ActiveWorkbook.Name
getMoreSpeed True
With Workbooks(RC1Dateiname).Worksheets("Tabellen_Ausgabe")
Set myTableArray = .Range(.Cells(myFirstRow, myFirstColumn), .Cells(myLastRow, _
myLastColumn))
End With
myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, myColumnIndex, _
False)
DestinationRange = myVLookupResult
Set DestinationRange = Range("E5")
myColumnIndex = 5
myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, _
myColumnIndex, False)
DestinationRange = myVLookupResult
Set DestinationRange = Range("F5")
myColumnIndex = 6
myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, _
myColumnIndex, False)
DestinationRange = myVLookupResult
Set DestinationRange = Range("G5")
myColumnIndex = 7
myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, _
myColumnIndex, False)
DestinationRange = myVLookupResult
Set DestinationRange = Range("h5")
myColumnIndex = 8
myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, _
myColumnIndex, False)
DestinationRange = myVLookupResult
Set DestinationRange = Range("i5")
myColumnIndex = 9
myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, _
myColumnIndex, False)
DestinationRange = myVLookupResult
Set DestinationRange = Range("K5")
myColumnIndex = 10
myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, _
myColumnIndex, False)
DestinationRange = myVLookupResult
Set DestinationRange = Range("L5")
myColumnIndex = 11
myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, _
myColumnIndex, False)
DestinationRange = myVLookupResult
Set DestinationRange = Range("M5")
myColumnIndex = 12
myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, _
myColumnIndex, False)
DestinationRange = myVLookupResult
Set DestinationRange = Range("n5")
myColumnIndex = 13
myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, _
myColumnIndex, False)
DestinationRange = myVLookupResult
Set DestinationRange = Range("o5")
myColumnIndex = 14
myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, _
myColumnIndex, False)
DestinationRange = myVLookupResult
Set DestinationRange = Range("p5")
myColumnIndex = 15
myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, _
myColumnIndex, False)
DestinationRange = myVLookupResult
Set DestinationRange = Range("q5")
myColumnIndex = 16
myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, _
myColumnIndex, False)
DestinationRange = myVLookupResult
Set DestinationRange = Range("r5")
'myColumnIndex = 17
'myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, _
myColumnIndex, False)
myVLookupResult = 100 'Lastrada nimmt kein Durchgang 56mm
DestinationRange = myVLookupResult
Set DestinationRange = Range("w5")
myColumnIndex = 25
myVLookupResult = WorksheetFunction.VLookup(myLookupValue, myTableArray, _
myColumnIndex, False)
DestinationRange = myVLookupResult
Workbooks(RC1Dateiname).Close savechanges:=False
getMoreSpeed False
End If
End With
End Function