Um die Formel in Zelle B3 bequem zu erzeugen, hilft der nachfolgende Code.
Code für ein allgemeines Modul:
Public Sub Create_Sverweis()
'########################################################################################
'Code erzeugt in der aktiven Zelle eine Sverweisformel mit integrierter Matrix.
'Autor: Jürgen Hennekes
'Erste Inputbox erwartet die Zelle mit dem Suchkriterium
'Zweite Inputbox erwartet die Zellen der Suchspalte
'Dritte Inputbox erwartet die Zellen der Ergebnisspalte
'########################################################################################
On Error Resume Next
Dim objDic As Object
Dim vntKey As Variant
Dim rngCrit As Range
Dim rngCol1 As Range
Dim rngCol2 As Range
Dim intI As Integer
Dim strFormula As String
Set objDic = CreateObject("Scripting.Dictionary")
Set rngCrit = Application.InputBox("Bitte die Zelle mit dem Suchkriterium auswählen", "Suchkriterium", , , , , , 8)
Set rngCol1 = Application.InputBox("Bitte Zellen in der Suchspalte auswählen", "Spalte1", , , , , , 8)
Set rngCol2 = Application.InputBox("Bitte Zellen in der Ergebnisspalte auswählen", "Spalte2", , , , , , 8)
If rngCrit Is Nothing Or rngCol1 Is Nothing Or rngCol2 Is Nothing Then Exit Sub
On Error GoTo 0
For intI = 1 To rngCol1.Cells.Count
If IsNumeric(rngCol2.Cells(intI, 1).Value) Then
objDic(rngCol1.Cells(intI, 1).Value) = rngCol2.Cells(intI, 1).Value
Else
objDic(rngCol1.Cells(intI, 1).Value) = """" & rngCol2.Cells(intI, 1).Value & """"
End If
Next
For Each vntKey In objDic.keys
strFormula = strFormula & vntKey & "." & objDic.Item(vntKey) & ";"
Next
strFormula = "=SVERWEIS(" & rngCrit.Address & ";{" & Left(strFormula, Len(strFormula) - 1) & "};2)"
ActiveCell.FormulaLocal = strFormula
Set rngCrit = Nothing
Set rngCol1 = Nothing
Set rngCol2 = Nothing
Set objDic = Nothing
End Sub
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
