Делать то, что делает COUNTIF, но включая объединенные ячейки

Question

Да, я знаю, объединенные ячейки плохие, но они нужны мне по эстетическим соображениям!

У меня есть группа ячеек с ярлыком (краткий текст) на них;я хочу посчитать, сколько раз каждый помеченный присутствует в определенном диапазоне.Сделать это легко с помощью контрагента ... но эстетическое воздействие ужасно.Если я объединяю их все, внешний вид хороший, но countif больше не помогает, потому что он считает всю ячейку как одну.

Я пытался выяснить, как сделать то, что я хочу, с модулем vba., но я слишком плох для этого.

Этот дает мне количество ячеек из первой ячейки, в которой есть строка, которую я ищу.

Function dcounter(r As Range, s As String) As Integer
   dcounter = 0
   If Not r.Find(s) Is Nothing Then dcounter = r.Find(s).MergeArea.Cells.Count
End Function

Мне просто нужно вычислитькак это зациклить для всего диапазона.Я пытался играть с For Each без успеха.Любое предложение?

Answer 1

Попробуйте вместо этого этот код:

Function dcounter(r As Range, s As String) As Integer
  Dim c As Range
  For Each c In r
    If c.Value = s Then
      dcounter = dcounter + c.MergeArea.Count
    End If
  Next
End Function

Ссылка: Метод Range.Find - для каждого ... Далее

Answer 2

Примерно так:

Function CountMerged(rng As Range, txt As String)
    Dim col As Collection, n As Long, c
    Set col = FindAll(rng, txt)
    For Each c In col
        n = n + c.MergeArea.Count
    Next c
    CountMerged = n
End Function

Public Function FindAll(rng As Range, val As String) As Collection

    Dim rv As New Collection, f As Range
    Dim addr As String

    Debug.Print rng.Cells.Count

    Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.Count), _
        LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext)

    If Not f Is Nothing Then addr = f.Address()

    Do Until f Is Nothing
        Debug.Print f.Address
        rv.Add f
        'Note: FindNext() won't work in a UDF
        Set f = rng.Find(what:=val, after:=f)
        If f.Address() = addr Then Exit Do
    Loop

    Set FindAll = rv
End Function

Примечание - слияние / разложение не вызовет пересчет UDF, даже если вы добавите Application.Volatile Хотя из вашего вопроса не понятноищете ли вы UDF ...