Benannte Bereiche - Named Ranges - die 2te...

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.
Option Explicit
Private Sub Workbook_Open()
    If ActiveCell.Column = 4 Then
        If ActiveCell.Value <> "" Then
            strOldName = ActiveCell.Value
        End If
    End If
End Sub

Code gehört in ein allgemeines Modul / Code belongs in a general module.
Option Explicit
Public strOldName As String

Code gehört in das Klassenmodul des Tabellenblattes / Code belongs to the class module of the worksheet.
Option Explicit
'--------------------------------------------------------------------------
' Module    : Sheet1
' Procedure : Worksheet_Change
' Author    : Case (Ralf Stolzenburg)
' Date      : 25.10.2013
' Purpose   : Create/Delete named ranges - entries in column D...
'--------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fin:
    #If VBA7 Then
        If Not Target.CountLarge > 1 Then
    #Else
        If Not Target.Count > 1 Then
    #End If
        Application.EnableEvents = False
        If Not Target.Column <> 4 Then
            If Trim(Target.Value) <> "" Then
                ThisWorkbook.Names.Add Name:=Target.Value, _
                    RefersToR1C1:="=" & _
                    Me.Name & "!" & "R" & Target.Row & "C" & _
                    Target.Column + 1 & ":" & "R" & _
                    Target.Row & "C" & Target.Column + 9
            Else
                ThisWorkbook.Names(strOldName).Delete
            End If
        End If
    End If
Fin:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'--------------------------------------------------------------------------
' Module    : Sheet1
' Procedure : Worksheet_SelectionChange
' Author    : Case (Ralf Stolzenburg)
' Date      : 25.10.2013
' Purpose   : Create/Delete named ranges - entries in column D...
'--------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    #If VBA7 Then
       If Not Target.CountLarge > 1 Then
    #Else
        If Not Target.Count > 1 Then
    #End If
        strOldName = Target.Value
    End If
End Sub

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...