Abstract

In älteren Excel Versionen konnte man mit dem Excel4 Makro ZELLE.ZUORDNEN interessante Zellinformationen ausgeben. Zum Beispiel konnte man den Namen HatFormel mit dem Wert

=ZELLE.ZUORDNEN(48;INDIREKT("ZS(-1)";FALSCH))

im Namensmanager definieren. Wenn Sie dann =HatFormel in der Zelle rechts neben einer gewünschten Zelle eingegeben hätten, dann würde diese anzeigen ob die gewünschte Zelle eine Formel enthält (“WAHR”) oder nicht (“FALSCH”).

Sie können mit VBA ähnliche Informationen ausgeben lassen:

Appendix – Programmcode sbGetCell

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Function sbGetCell(r As Range, s As String) As Variant
'Source (EN): http://www.sulprobil.de/sbgetcell_en/
'Source (DE): http://www.berndplumhoff.de/sbgetcell_de/
'Bernd Plumhoff V0.33 30-Oct-2022
With Application.WorksheetFunction
Application.Volatile
Select Case s
Case "AbsReference", "1"
    'Absolute style reference like $A$1
    If Application.Caller.Parent.Parent.Name = _
        r.Worksheet.Parent.Name And _
        Application.Caller.Parent.Name = r.Worksheet.Name Then
        sbGetCell = r.Address
    Else
        If InStr(r.Worksheet.Parent.Name & _
            r.Worksheet.Name, " ") > 0 Then
            sbGetCell = "'[" & r.Worksheet.Parent.Name & "]" & _
            r.Worksheet.Name & "'!" & r.Address
        Else
            sbGetCell = "[" & r.Worksheet.Parent.Name & "]" & _
            r.Worksheet.Name & "!" & r.Address
        End If
    End If
Case "RowNumber", "2"
    'Row number in the top cell reference
    sbGetCell = r.Row
Case "ColumnNumber", "3"
    'Column number of the leftmost cell in reference
    sbGetCell = r.Column
Case "Type", "4"
    'Same as TYPE(reference)
    sbGetCell = -IsEmpty(r) - .IsNumber(r) - .IsText(r) * 2 - .IsLogical(r) _
                * 4 - .IsError(r) * 16 - IsArray(r) * 64
Case "Contents", "5"
    'Contents of reference
    sbGetCell = r.Value
Case "FormulaLocal", "ShowFormula", "6"
    'Cell formula
    sbGetCell = r.FormulaLocal
Case "NumberFormat", "7"
    'Number format of cell
    sbGetCell = r.NumberFormatLocal
Case "HorizontalAlignment", "8"
    'Number indicating the cell's horizontal alignment
    Select Case r.HorizontalAlignment
    Case xlGeneral
        sbGetCell = 1
    Case xlLeft
        sbGetCell = 2
    Case xlCenter
        sbGetCell = 3
    Case xlRight
        sbGetCell = 4
    Case xlFill
        sbGetCell = 5
    Case xlJustify
        sbGetCell = 6
    Case xlCenterAcrossSelection
        sbGetCell = 7
    Case xlDistributed
        sbGetCell = 8
    Case Else
        Debug.Assert False 'Should not get here
    End Select
Case "LeftBorderStyle", "9"
    'Number indicating the left-border style assigned to the cell
    Select Case r.Borders(1).LineStyle
    Case xlLineStyleNone
        sbGetCell = 0
    Case xlHairline
        sbGetCell = IIf(r.Borders(1).Weight = xlMedium, 2, 7)
    Case xlDot
        sbGetCell = 4
    Case xlDashDotDot
        sbGetCell = IIf(r.Borders(1).Weight = xlMedium, 12, 11)
    Case xlDashDot
        sbGetCell = IIf(r.Borders(1).Weight = xlMedium, 10, 9)
    Case xlDash
        sbGetCell = IIf(r.Borders(1).Weight = xlMedium, 8, 3)
    Case xlSlantDashDot
        sbGetCell = 13
    Case xlDouble
        sbGetCell = 6
    Case Else
        sbGetCell = CVErr(xlErrValue)
    End Select
Case "RightBorderStyle", "10"
    'Number indicating the right-border style assigned to the cell
    Select Case r.Borders(2).LineStyle
    Case xlLineStyleNone
        sbGetCell = 0
    Case xlHairline
        sbGetCell = IIf(r.Borders(2).Weight = xlMedium, 2, 7)
    Case xlDot
        sbGetCell = 4
    Case xlDashDotDot
        sbGetCell = IIf(r.Borders(2).Weight = xlMedium, 12, 11)
    Case xlDashDot
        sbGetCell = IIf(r.Borders(2).Weight = xlMedium, 10, 9)
    Case xlDash
        sbGetCell = IIf(r.Borders(2).Weight = xlMedium, 8, 3)
    Case xlSlantDashDot
        sbGetCell = 13
    Case xlDouble
        sbGetCell = 6
    Case Else
        sbGetCell = CVErr(xlErrValue)
    End Select
Case "TopBorderStyle", "11"
    'Number indicating the top-border style assigned to the cell
    Select Case r.Borders(3).LineStyle
    Case xlLineStyleNone
        sbGetCell = 0
    Case xlHairline
        sbGetCell = IIf(r.Borders(3).Weight = xlMedium, 2, 7)
    Case xlDot
        sbGetCell = 4
    Case xlDashDotDot
        sbGetCell = IIf(r.Borders(3).Weight = xlMedium, 12, 11)
    Case xlDashDot
        sbGetCell = IIf(r.Borders(3).Weight = xlMedium, 10, 9)
    Case xlDash
        sbGetCell = IIf(r.Borders(3).Weight = xlMedium, 8, 3)
    Case xlSlantDashDot
        sbGetCell = 13
    Case xlDouble
        sbGetCell = 6
    Case Else
        sbGetCell = CVErr(xlErrValue)
    End Select
Case "BottomBorderStyle", "12"
    'Number indicating the bottom-border style assigned to the cell
    Select Case r.Borders(4).LineStyle
    Case xlLineStyleNone
        sbGetCell = 0
    Case xlHairline
        sbGetCell = IIf(r.Borders(4).Weight = xlMedium, 2, 7)
    Case xlDot
        sbGetCell = 4
    Case xlDashDotDot
        sbGetCell = IIf(r.Borders(4).Weight = xlMedium, 12, 11)
    Case xlDashDot
        sbGetCell = IIf(r.Borders(4).Weight = xlMedium, 10, 9)
    Case xlDash
        sbGetCell = IIf(r.Borders(4).Weight = xlMedium, 8, 3)
    Case xlSlantDashDot
        sbGetCell = 13
    Case xlDouble
        sbGetCell = 6
    Case Else
        sbGetCell = CVErr(xlErrValue)
    End Select
Case "Pattern", "13"
    'Number indicating cell pattern
    sbGetCell = r.Interior.Pattern
Case "IsLocked", "14"
    'True if cell is locked
    sbGetCell = r.Locked
Case "FormulaHidden", "HiddenFormula", "15"
    'True if cell formula is hidden
    sbGetCell = r.FormulaHidden
Case "Width", "CellWidth", "16"
    'Cell width. If array-entered into two cells of a row,
    'second value is true if width is standard
    sbGetCell = Array(r.ColumnWidth, r.UseStandardWidth) 'Not width!
Case "Height", "RowHeight", "17"
    'Cell height
    sbGetCell = r.RowHeight
Case "FontName", "18"
    'Cell font name
    sbGetCell = r.Font.Name
Case "FontSize", "19"
    'Cell font size
    sbGetCell = r.Font.Size
Case "IsBold", "20"
    'Cell is formatted bold?
    sbGetCell = r.Font.Bold
Case "IsItalic", "21"
    'Cell is formatted in Italics?
    sbGetCell = r.Font.Italic
Case "IsUnderlined", "22"
    'Cell is formatted as underlined?
    sbGetCell = (r.Font.Underline = xlUnderlineStyleSingle Or _
                 r.Font.Underline = xlUnderlineStyleSingleAccounting Or _
                 r.Font.Underline = xlUnderlineStyleDouble Or _
                 r.Font.Underline = xlUnderlineStyleDoubleAccounting)
Case "IsStruckThrough", "23"
    'Cell characters are struck through?
    sbGetCell = r.Font.Strikethrough
Case "FontColorIndex", "24"
    'Cell font color of first character, 1-56, 0 = automatic
    sbGetCell = r.Font.ColorIndex
Case "IsOutlined", "25", "IsShaddowed", "26"
    'Cell font is outlined or shaddowed? (Not supported by Excel)
    sbGetCell = False
Case "PageBreak", "27"
    '0 = no break, 1 = row, 2 = column, 3 = row and column
    sbGetCell = -(r.EntireRow.PageBreak <> xlPageBreakNone) - 2 * (r.EntireColumn.PageBreak <> xlPageBreakNone)
Case "RowLevelOutline", "28"
    'Row level outline
    sbGetCell = r.EntireRow.OutlineLevel
Case "ColumnLevelOutline", "29"
    'Row level outline
    sbGetCell = r.EntireColumn.OutlineLevel
Case "IsSummaryRow", "30"
    'Row is a summary row?
    sbGetCell = r.EntireRow.Summary
Case "IsSummaryColumn", "31"
    'Column is a summary column?
    sbGetCell = r.EntireColumn.Summary
Case "WorkbookSheetName", "32"
    'Workbook name like [Book1.xls]Sheet1 or Book1.xls if
    'workbook and single sheet have
    'identical names
    If r.Worksheet.Parent.Name = r.Worksheet.Name & ".xls" And _
        Application.Worksheets.Count = 1 Then
        sbGetCell = r.Worksheet.Parent.Name
    Else
        sbGetCell = "[" & r.Worksheet.Parent.Name & "]" & _
        r.Worksheet.Name
    End If
Case "IsWrapped", "33"
    'Cell text is formatted as wrapped?
    sbGetCell = r.WrapText
Case "LeftBorderColorIndex", "34"
    'Left border color index
    sbGetCell = r.Borders.Item(1).ColorIndex
Case "RightBorderColorIndex", "35"
    'Right border color index
    sbGetCell = r.Borders.Item(2).ColorIndex
Case "TopBorderColorIndex", "36"
    'Top border color index
    sbGetCell = r.Borders.Item(3).ColorIndex
Case "BottomBorderColorIndex", "37"
    'Bottom border color index
    sbGetCell = r.Borders.Item(4).ColorIndex
Case "ShadeForeGroundColor", "38", "PatternBackGroundColor", "64"
    'ShadeForeGroundColor
    sbGetCell = r.Interior.PatternColorIndex
Case "ShadeBackGroundColor", "39", "PatternForeGroundColor", "63"
    'ShadeBackGroundColor
    sbGetCell = r.Interior.ColorIndex
Case "TextStyle", "40"
    'Style of the cell, as text
    sbGetCell = r.Style.NameLocal
Case "FormulaWOT", "41"
    'Returns the formula in the active cell without translating it (useful for international macro sheets)
    sbGetCell = r.Formula
'Case "HDistWinToLCell", "42"
'    'Horizontal distance, measured in points, from the left edge of the active window to the left edge of the cell
'    sbGetCell = r. 'Does not work yet
Case "HasNote", "46"
    'True if cell contains a text note
    sbGetCell = Len(r.NoteText) > 0
Case "HasSound", "47"
    'True if cell has a sound note. Not supported.
    sbGetCell = False
Case "HasFormula", "48"
    'True if cell contains a formula
    sbGetCell = r.HasFormula
Case "IsArray", "49"
    'True if cell is part of an array formula
    sbGetCell = r.HasArray
Case "VerticalAlignment", "50"
    '1 = Top, 2 = Center, 3 = Bottom, 4 = Justified, 5 = Distributed
    sbGetCell = -(r.VerticalAlignment = xlVAlignTop) - 2 * (r.VerticalAlignment = xlVAlignCenter) - _
                3 * (r.VerticalAlignment = xlVAlignBottom) - 4 * (r.VerticalAlignment = xlVAlignJustify) - _
                5 * (r.VerticalAlignment = xlVAlignDistributed)
Case "VerticalOrientation", "51"
    '0 = Horizontal, 1 = Vertical, 2 = Upward, 3 = Downward
    sbGetCell = -(r.Orientation = xlVertical) - 2 * (r.Orientation = xlUpward) - _
                3 * (r.Orientation = xlDownward)
Case "IsStringConst", "IsStringConstant", "52"
    'Text alignment char "'" if cell is a string constant,
    'empty string "" if not
    sbGetCell = r.PrefixCharacter
Case "AsText", "53"
    'Cell displayed as text with numbers formatted and symbols included
    sbGetCell = r.Text
Case "PivotTableViewName", "54"
    'PivotTableViewName
    sbGetCell = r.PivotTable.Name
'Case "PivotTableViewPosition", "55"
'    'PivotTableViewPosition
'    sbGetCell = r.PivotField.Position 'Not correct yet
Case "PivotTableViewFieldName", "56"
    'PivotTableViewFieldName
    sbGetCell = r.PivotField.Name
Case "IsSuperscript", "57"
    'Cell text is formatted as superscript?
    sbGetCell = r.Font.Superscript
Case "FontStyleText", "58"
    'FontStyleText
    sbGetCell = r.Font.FontStyle
Case "UnderlineStyle", "59"
    'Underline style, 1 = none, 2 = single, 3 = double, 4 = single accounting, 5 = double accounting
    Select Case r.Font.Underline
    Case xlUnderlineStyleNone
        sbGetCell = 1
    Case xlUnderlineStyleSingle
        sbGetCell = 2
    Case xlUnderlineStyleDouble
        sbGetCell = 3
    Case xlUnderlineStyleSingleAccounting
        sbGetCell = 4
    Case xlUnderlineStyleDoubleAccounting
        sbGetCell = 5
    Case Else
        sbGetCell = CVErr(xlErrValue)
    End Select
Case "IsSubscript", "60"
    'Cell text is formatted as subscript?
    sbGetCell = r.Font.Subscript
Case "PivotTableItemName", "61"
    'PivotTableItemName
    sbGetCell = r.PivotItem.Name
Case "WorksheetName", "62"
    'Worksheet name like [Book1.xls]Sheet1
        sbGetCell = "[" & r.Worksheet.Parent.Name & "]" & _
                    r.Worksheet.Name
Case "IsAddIndentAlignment", "65"
    'Only Far East Excel Versions
    sbGetCell = False 'Not supported here
Case "WorkbookName", "66"
    'Workbook name like Book1.xls
    sbGetCell = r.Worksheet.Parent.Name
Case "IsHidden"
    'Cell hidden?
    sbGetCell = r.EntireRow.Hidden Or r.EntireColumn.Hidden
Case Else
    sbGetCell = CVErr(xlErrValue)
End Select
End With
End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

sbgetcell.xlsm [40 KB Excel Datei, Download und Nutzung auf eigene Gefahr]