AW: Spalteninhalt nach Vorgabe in Zelle
17.08.2010 17:54:42
ransi
HAllo Detlev
Vor geraumer Zeit hatte ich mal das gleiche Problem.
Wollte das auch nur mit Formeln lösen.
ISt machbar, aber dann brauchst du ohne Ende Hilfszellen...
Mit 2 kleinen UDF's ist das aber kein Problem.
Kannst du nutzen wie "Formeln".
| | A | B | C | D | E |
| 1 | Quelldaten | | | Zieldaten | |
| 2 | Name | Kennung | | Name | Kennung |
| 3 | Müller | 123 | | Müller | 123, 234, 456 |
| 4 | Meier | 234 | | Meier | 234, 789, 123 |
| 5 | Schulze | 713 | | Schulze | 713 |
| 6 | Müller | 234 | | | |
| 7 | Meier | 789 | | | |
| 8 | Schulze | 713 | | | |
| 9 | Müller | 456 | | | |
| 10 | Meier | 123 | | | |
| 11 | Schulze | 713 | | | |
| 12 | Müller | 123 | | | |
| 13 | Müller | 123 | | | |
| 14 | Müller | 123 | | | |
| 15 | Müller | 123 | | | |
| 16 | Müller | 123 | | | |
| 17 | Müller | 123 | | | |
| 18 | | | | | |
| Formeln der Tabelle |
| Zelle | Formel | | D3 | =INDEX(machs($A$3:$A$40); ZEILE(A1)) | | E3 | =sverweis2(D3;$A$1:$B$40;1;2;WAHR) |
|
Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Das sind die Codes:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Public Function machs(rng As Variant) As Variant
Dim Mydic As Object
Dim arr As Variant
Dim L As Long
Set Mydic = CreateObject("Scripting.Dictionary")
arr = rng
For L = LBound(arr) To UBound(arr)
Mydic(arr(L, 1)) = 0
Next
machs = Mydic.keys
End Function
Public Function SVERWEIS2(Kriterium As String, _
Bereich As Range, _
SuchSpalte As Integer, _
ErgebnissSpalte As Integer, _
Optional Unikate As Boolean = True, _
Optional Trenner As String = ", ") As String
Dim arrTmp
Dim L As Long
Dim Mydic As Object
arrTmp = Bereich
Set Mydic = CreateObject("Scripting.Dictionary")
If Unikate = True Then
For L = 1 To UBound(arrTmp)
If arrTmp(L, SuchSpalte) = Kriterium Then Mydic(arrTmp(L, ErgebnissSpalte)) = 0
Next
SVERWEIS2 = Join(Mydic.keys, Trenner)
Else:
For L = 1 To UBound(arrTmp)
If arrTmp(L, SuchSpalte) = Kriterium Then Mydic(L) = arrTmp(L, ErgebnissSpalte)
Next
SVERWEIS2 = Join(Mydic.items, Trenner)
End If
End Function
ransi