Как я могу сделать вызываемую ячейку уникальной для каждого листа? - PullRequest
0 голосов
/ 01 сентября 2018

Я создал UDF, для которого требуется содержимое первой непустой ячейки над ней. Я назвал переменную для содержимого "PriorFootnote". К сожалению, мой UDF записывает только содержимое активного листа как «PriorFootnote» и переносит это значение в UDF, когда UDF размещается на других листах. Каждый лист должен иметь уникальный «PriorFootnote» в зависимости от того, где находится первая непустая ячейка на этом листе. Короче говоря, мой UDF работает только на активном листе. Как я могу сделать свой UDF более динамичным?

Вот проблемный код.

    With Application.Caller.Parent

        If IsEmpty(Cells(Application.Caller.Row - 1, Application.Caller.Column)) Then

            PriorFootnote = Cells(Application.Caller.Row, Application.Caller.Column).End(xlUp).Value

        Else

            PriorFootnote = Cells(Application.Caller.Row - 1, Application.Caller.Column).Value

        End If

    End With

FWIW, это весь код:

Function Footnote(Optional FootnoteX As Variant)

Dim FootnoteNumArray, FootnoteLetArray, PriorFootnoteUni As Variant
Dim PriorFootnote, OnesChar, TensChar As String
Dim ArrayPos, OnesArrayPos, TensArrayPos, TensCharUni, OnesCharUni As Integer

 FootnoteNumArray = Array(8304, 185, 178, 179, 8308, 8309, 8310, 8311, 8312, 8313)
'FootnoteNumArray = Supercript[(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)]

 FootnoteLetArray = Array(7491, 7495, 7580, 7496, 7497, 7584, 7501, 688, 8305, 690, 7503, 737, 7504, 8319, 7506, 7510, 32, 691, 738, 7511, 7512, 7515, 695, 739, 696, 7611)
'FootnoteLetArray = Supercript[(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, _, r, s, t, u, v, w, x, y, z)]

 Application.Volatile

    If IsMissing(FootnoteX) Then

    '   Get prior footnote

        With Application.Caller.Parent

            If IsEmpty(Cells(Application.Caller.Row - 1, Application.Caller.Column)) Then

                PriorFootnote = Cells(Application.Caller.Row, Application.Caller.Column).End(xlUp).Value

            Else

                PriorFootnote = Cells(Application.Caller.Row - 1, Application.Caller.Column).Value

            End If

        End With

     '  Prior footnote is

        PriorFootnoteUni = Application.Unicode(PriorFootnote)

            'If prior footnote is a number, check its length and convert the footnote Unicode to a number + 1

             If IsNumeric(Application.Match(PriorFootnoteUni, FootnoteNumArray, 0)) Then

                 If Len(PriorFootnote) = 1 Then

                     ArrayPos = Application.Match(PriorFootnoteUni, FootnoteNumArray, 0)
                     FootnoteX = ArrayPos
                     Footnote = FootnoteNumLet(FootnoteX)

                 Else

                     TensChar = VBA.Strings.Left(PriorFootnote, 1)
                     TensCharUni = Application.Unicode(TensChar)
                     TensArrayPos = Application.Match(TensCharUni, FootnoteNumArray, 0)

                     OnesChar = VBA.Strings.Right(PriorFootnote, 1)
                     OnesCharUni = Application.Unicode(OnesChar)
                     OnesArrayPos = Application.Match(OnesCharUni, FootnoteNumArray, 0)

                     FootnoteX = (TensArrayPos - 1) * 10 + OnesArrayPos
                     Footnote = FootnoteNumLet(FootnoteX)

                 End If 'one or two digits

             ElseIf IsNumeric(Application.Match(PriorFootnoteUni, FootnoteLetArray, 0)) Then

                 ArrayPos = Application.Match(PriorFootnoteUni, FootnoteLetArray, 0)
                 Footnote = Application.Unichar(FootnoteLetArray(ArrayPos))

             Else

                 Footnote = Application.Unichar(185)

             End If 'number or letter

    Else

        Footnote = FootnoteNumLet(FootnoteX)

    End If

End Function

1 Ответ

0 голосов
/ 01 сентября 2018

Даже если вы используете оператор With, вы его не используете. Сам оператор Cells() всегда возвращает значение из активного листа. Вы должны поместить точку перед свойством Cells() следующим образом:

With Application.Caller.Parent

    If IsEmpty(.Cells(Application.Caller.Row - 1, Application.Caller.Column)) Then

        PriorFootnote = .Cells(Application.Caller.Row, Application.Caller.Column).End(xlUp).Value

    Else

        PriorFootnote = .Cells(Application.Caller.Row - 1, Application.Caller.Column).Value

    End If

End With

Это должно быть отсортировано.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...