Frage: Noch einmal eine Frage zu benannten Bereichen. Wenn in Spalte D ein Name eingegeben wird, soll ein benannter Bereich erstellt werden mit dem Bereich Spalt E bis Spalte M der jeweiligen Zeile. Wird der Eintrag in Spalte D gelöscht, soll auch der benannte Bereich gelöscht werden. Wie geht das?
Once again about named ranges. If a name is entered in column D, is a named range are created using the gap area E to the M column of the respective row. If the entry is deleted in column D, also the named range to be deleted. How does it work?
Hier noch eine Beispieldatei / Here's a sample file:
Benannte Bereiche - Named Ranges - die 2te...[ZIP 20 KB]
Code gehört in DieseArbeitsmappe / Code is in ThisWorkbook.
Code gehört in ein allgemeines Modul / Code belongs in a general module.
Code gehört in das Klassenmodul des Tabellenblattes / Code belongs to the class module of the worksheet.
Once again about named ranges. If a name is entered in column D, is a named range are created using the gap area E to the M column of the respective row. If the entry is deleted in column D, also the named range to be deleted. How does it work?
Hier noch eine Beispieldatei / Here's a sample file:
Benannte Bereiche - Named Ranges - die 2te...[ZIP 20 KB]
Code gehört in DieseArbeitsmappe / Code is in ThisWorkbook.
OptionExplicit
PrivateSubWorkbook_Open()
IfActiveCell.Column=4Then
IfActiveCell.Value<>""Then
strOldName=ActiveCell.Value
EndIf
EndIf
EndSub
Code gehört in ein allgemeines Modul / Code belongs in a general module.
OptionExplicit
PublicstrOldNameAsString
Code gehört in das Klassenmodul des Tabellenblattes / Code belongs to the class module of the worksheet.
OptionExplicit
'--------------------------------------------------------------------------
' Module : Sheet1
' Procedure : Worksheet_Change
' Author : Case (Ralf Stolzenburg)
' Date : 25.10.2013
' Purpose : Create/Delete named ranges - entries in column D...
'--------------------------------------------------------------------------
PrivateSubWorksheet_Change(ByValTargetAsRange)
OnErrorGoToFin:
#If VBA7 Then
IfNotTarget.CountLarge>1Then
#Else
IfNotTarget.Count>1Then
#End If
Application.EnableEvents=False
IfNotTarget.Column<>4Then
IfTrim(Target.Value)<>""Then
ThisWorkbook.Names.AddName:=Target.Value,_
RefersToR1C1:="="&_
Me.Name&"!"&"R"&Target.Row&"C"&_
Target.Column+1&":"&"R"&_
Target.Row&"C"&Target.Column+9
Else
ThisWorkbook.Names(strOldName).Delete
EndIf
EndIf
EndIf
Fin:
Application.EnableEvents=True
IfErr.Number<>0ThenMsgBox"Error: "&_
Err.Number&" "&Err.Description
EndSub
'--------------------------------------------------------------------------
' Module : Sheet1
' Procedure : Worksheet_SelectionChange
' Author : Case (Ralf Stolzenburg)
' Date : 25.10.2013
' Purpose : Create/Delete named ranges - entries in column D...
'--------------------------------------------------------------------------
PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)
#If VBA7 Then
IfNotTarget.CountLarge>1Then
#Else
IfNotTarget.Count>1Then
#End If
strOldName=Target.Value
EndIf
EndSub