не может изменить простой функциональный макрос Excel на похожий на функцию - PullRequest
Новая
       91

не может изменить простой функциональный макрос Excel на похожий на функцию

0 голосов
/ 14 июля 2020

Я совершенно новичок в VBA и макросах в Excel. У меня был макрос, который опубликовал какой-то хороший парень, и он отлично работает, но он мне нужен как функция, поэтому я пытался и пытался, но, честно говоря, полностью потерялся. Я буду очень признателен за вашу помощь. Сначала макросы и, наконец, функция. Я думал, что у меня все хорошо, но пока нет хороших результатов. Кстати, контекст: это макрос для подсчета ячеек по цветам с условным форматированием (без формулы !!) в excel. 

Sub DisplayColorCount()
    Dim Rng As Range
    Dim CountRange As Range
    Dim ColorRange As Range
    Dim xBackColor As Long
    On Error Resume Next
    xTitleId = "dptutorials"
    Set CountRange = Application.Selection
    Set CountRange = Application.InputBox("Count Range :", xTitleId, CountRange.Address, Type:=8)
    Set ColorRange = Application.InputBox("Color Range(single cell):", xTitleId, Type:=8)
    Set ColorRange = ColorRange.Range("A1")
    xReturn = 0
    For Each Rng In CountRange
        qqq = Rng.Value
        xxx = Rng.DisplayFormat.Interior.Color
        If Rng.DisplayFormat.Interior.Color = ColorRange.DisplayFormat.Interior.Color Then
            xBackColor = xBackColor + 1
        End If
    Next
    ActiveCell.Value = xBackColor
End Sub

Function DisplayColorCount2(CountRange As Range, ColorRange As Range)
    Dim Rng As Range
    'Dim CountRange As Range
    'Dim ColorRange As Range
    Dim xBackColor As Long
    On Error Resume Next
    'xTitleId = "dptutorials"
    'Set CountRange = Application.Selection
    'Set CountRange = Application.InputBox("Count Range :", xTitleId, CountRange.Address, Type:=8)
    'Set ColorRange = Application.InputBox("Color Range(single cell):", xTitleId, Type:=8)
    'Set ColorRange = ColorRange.Range("A1")
    xReturn = 0
    For Each Rng In CountRange
        qqq = Rng.Value
        xxx = Rng.DisplayFormat.Interior.Color
        If Rng.DisplayFormat.Interior.Color = ColorRange.DisplayFormat.Interior.Color Then
            xBackColor = xBackColor + 1
        End If
    Next
    DisplayColorCount2 = xBackColor
End Function
...