Как вместо RegEx
Настройте значения в разделе констант.
Option Explicit
'START ****************************************************************** START'
' Title: Count Owners '
' Purpose: Counts the number of cells containing a string starting with '
' a lower-case character below a cell containing a string '
' starting with an upper-case character and writes the result '
' to the same row of the string starting with the upper-case '
' character, in another (specified) column. '
'******************************************************************************'
Sub CountOwners()
Const wsName As String = "Sheet1" ' Worksheet Name
Const rowHeader As Long = 3 ' Header Row
Const colOwner As Long = 2 ' Owner Column Number
Const colCount As Long = 3 ' Count Column Number
Dim rng As Range ' Owner Column, Owner Column Range,
' Count Column Range
Dim vntOwner As Variant ' Owner Array
Dim vntCount As Variant ' Count Array
Dim LneRinC As Long ' Last Non-Empty Row in Owner Column
Dim UB As Long ' Arrays Last Element Count
Dim lngOwner As Long ' Current Owner Element (Row)
Dim lngCount As Long ' (Current) Owner Count(er)
Dim i As Long ' First Arrays Element Counter
Dim j As Long ' Second Arrays Element Counter
Dim strChar As String * 1 ' Current Char
' IN WORKSHEET
' Define Owner Column.
Set rng = ThisWorkbook.Worksheets(wsName).Columns(colOwner)
' Using the Find method, try to define Owner Column Range.
Set rng = rng.Find("*", , xlFormulas, , , xlPrevious)
' Check if no data in Owner Column.
If rng Is Nothing Then GoTo NoData
' Calculate Last Non-Empty Row in Owner Column.
LneRinC = rng.Row
' Check if no Owners in Owner Column Range.
If LneRinC <= rowHeader Then GoTo NoOwners
' Define Owner Column Range.
Set rng = rng.Parent.Cells(rowHeader + 1, colOwner).Resize(LneRinC - rowHeader)
' Write values of Owner Column Range to Owner Array.
vntOwner = rng
' IN ARRAYS
' Define Arrays Last Element Count
UB = UBound(vntOwner)
' Resize Count Array (vntCount) to the size of Owner Array (vntOwner).
ReDim vntCount(1 To UB, 1 To 1)
' Loop through elements of Owner Array.
For i = 1 To UB
' Write first characterg of current element in Owner Array
' to Current Char.
strChar = Left$(vntOwner(i, 1), 1)
' Check if current char is an uppercase character.
If strChar Like "[A-Z]" Then
' Assign the value of the current row of Owner Array
' to Current Owner Element (Row).
lngOwner = i
' Reset Current Owner Element.
lngCount = 0
' Loop through the rest of the elements in Owner Array.
For j = i + 1 To UB
' Write first character of current element in Owner Array
' to Current Char.
strChar = Left$(vntOwner(j, 1), 1)
' Check if Current Char is an uppercase letter.
If strChar Like "[A-Z]" Then
' Reset First Arrays Element Counter.
i = j - 1
Exit For
Else
' Check if Current Char is a lowercase letter.
If strChar Like "[a-z]" Then
' Increase (Current) Owner Counter.
lngCount = lngCount + 1
End If
End If
Next
' Write value of (Current) Owner Counter to Count Array.
vntCount(lngOwner, 1) = lngCount
End If
Next
' IN WORKSHEET
' Define Count Column Range.
Set rng = rng.Offset(, colCount - colOwner)
' Write values of Count Array to Count Column Range.
rng = vntCount
ProgramError:
Exit Sub
NoData:
MsgBox "There is no data in Owner column (" & colOwner & ")."
GoTo ProgramError
NoOwners:
MsgBox "There are no Owners in Owner column (" & colOwner & ")."
GoTo ProgramError
End Sub
'******************************************************************************'
' Remarks: Values not starting with alpha characters are not counted. '
' Owner Column Range doesn't have to start with an Owner. '
' Owner Column Range can end with an Owner; the count will be 0. '
'END ********************************************************************** END'