在VBA中，找到一个字符出现在一个单元格范围内单个单元格中的最大次数

mtm 发表于 Dev

MTM

在开始之前，我只想提前感谢每个贡献者。我之前只发布了一个问题，而我对得到答复的速度以及研究解决方案后学到的知识感到惊讶。我希望我很快就会有足够的信誉点，以开始支持在这里找到的好的解决方案。

无论如何，我想做的是返回一个数字，该数字是工作表列的单个单元格中出现的最大名称数。该列中的每个单元格可以具有任意数量的名称。每个名称都由竖线“ |”定界，因此我对管道进行计数，然后加一个以获取每个单元格中的名称数。例如：单元格值为“鲍勃|乔恩|拉里” = 2个管道+1 = 3个名称。

我下面的代码有效，但是我需要对成千上万的记录执行此操作。我认为我的解决方案不是实现此目标的好方法或有效方法（如果我做错了，请告诉我）。所以我的问题是：

有没有更好的方法可以做到这一点，例如不遍历范围内的每个单元格？
如果没有完全不同的方法，如何避免在新列的单元格中实际打印名称计数？我可以将这些值存储在数组中并计算数组的最大值吗？（也许您已经可以在这个话题上找到话题了吗？）

Sub charCnt()

Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual

Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = Worksheets("Leasing")
Dim vRange As Variant
Dim iCharCnt As Integer
Dim iRows As Integer
Dim i As Integer
Dim iMax As Integer

Const sFindChar As String = "|"

iRows = ws.Cells(Rows.Count, "A").End(xlUp).Row 'count number of rows

For i = 1 To iRows
     vRange = Cells(i, "O") 'column O has the names
    iCharCnt = Len(vRange) - Len(Replace(vRange, sFindChar, "")) 'find number of | in single cell.
    ws.Cells(i, "W") = iCharCnt 'column W is an empty column I use to store the name counts
Next i

iMax = Application.WorksheetFunction.Max(Range("W:W")) + 1 'return max from column W
    
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox ("Max number of names in one cell is " & iMax) ' show result

End Sub

VBasic2008

最大子串数

Option Explicit

Sub charCount()

    Const cCol As String = "O"
    Const fRow As Long = 1
    Const Delimiter As String = "|"
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Worksheets("Leasing")
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, cCol).End(xlUp).Row
    Dim rg As Range: Set rg = ws.Cells(fRow, cCol).Resize(lRow - fRow + 1)
    Dim Data As Variant: Data = rg.Value
    
    Dim i As Long
    For i = 1 To UBound(Data, 1)
        Data(i, 1) = Len(Data(i, 1)) - Len(Replace(Data(i, 1), Delimiter, ""))
    Next i
    Dim iMax As Long: iMax = Application.Max(Data) + 1
    
    MsgBox ("Max number of names in one cell is " & iMax) ' show result

End Sub