Ich habe in einer Tabelle bestimmten Zellen einen Namen gegeben. Wenn nun in einer dieser Zellen ein bestimmter Wert steht, möchte ich den Namen der entsprechenden Zelle in einer Zelle einer anderen Tabelle ausgegeben haben. Weiss hierfür jemand eine Lösung
Hallo Piet,
hier 2 Makros, die eine Auswertung der Zellen mit Namen machen und dabei den Namen in eine Zielzelle eintragen.
Sub prcCheckNames\_Var1()
Dim objName As Name, rngZiel As Range
'Inhalte der Zielzellen löschen
Worksheets("Tabelle2").Range("C2,C4,C6,C8").ClearContents
For Each objName In ActiveWorkbook.Names
With objName
If .Visible = True Then
Select Case .NameLocal
'zu prüfende Namen
Case "Name\_001", "Name\_002", "Name\_003", "Name\_004"
'Prüfwerte
Select Case .RefersToRange.Value
Case 1
Set rngZiel = Worksheets("Tabelle2").Range("C2")
Case 2
Set rngZiel = Worksheets("Tabelle2").Range("C4")
Case 3
Set rngZiel = Worksheets("Tabelle2").Range("C6")
Case 4
Set rngZiel = Worksheets("Tabelle2").Range("C8")
Case Else
Set rngZiel = Nothing
End Select
If Not rngZiel Is Nothing Then
rngZiel.Value = .Name
End If
End Select
End If
End With
Next
End Sub
Sub prcCheckNames\_Var2()
Dim objName As Name, rngZiel As Range
Set rngZiel = Worksheets("Tabelle2").Range("C4") 'Zelle in die Name eingetragen werden soll
'Inhalt der Zielzelle löschen
rngZiel.ClearContents
For Each objName In ActiveWorkbook.Names
With objName
If .Visible = True Then
Select Case .NameLocal
'zu prüfende Namen
Case "Name\_001", "Name\_002", "Name\_003", "Name\_004"
'Prüfung auf Wert
If .RefersToRange.Value = 1 Then
rngZiel.Value = .Name
Exit For
End If
End Select
End If
End With
Next
End Sub
Alternativ kann man auch eine benutzerdefinierte Funktion verwenden.
'Benutzerdefinierte Funktion in allgemeinem Modul
Public Function fncNamen\_Auswerten(strNamen As String, varWert, Optional strTrennzeichen As String = ";") As String
'strNamen =Text mit den durch Trennzeichen getrennten Namen
'varWert = Wert auf den die Bezugs-Zelle des Namens geprüft werden soll
'strTrennzeichen = Das in strText verwendetet Trennzeichen zwischen den Namen
'Beispiele für Formel:
'=fncNamen\_Auswerten("Name\_001,Name\_002,Name\_003,Name\_004";B11;",")
'=fncNamen\_Auswerten($A$11;B11;",") 'in A11 steht dann die Liste der Namen
Dim objName As Name
Dim arrNamen, intJ As Integer
Application.Volatile
fncNamen\_Auswerten = ""
arrNamen = VBA.Split(strNamen, strTrennzeichen)
For Each objName In ActiveWorkbook.Names
With objName
If .Visible = True Then
For intJ = LBound(arrNamen) To UBound(arrNamen)
If .NameLocal = arrNamen(intJ) Then
'Prüfung auf Wert
If .RefersToRange.Value = varWert Then
fncNamen\_Auswerten = .Name
Exit Function
End If
End If
Next
End If
End With
Next
End Function
Gruß
Franz