4

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

无论如何，我要做的是返回一个数字，该数字是出现在工作表列的单个单元格中的最大名称数。该列中的每个单元格都可以包含任意数量的名称。每个名称都由管道“|”分隔，因此我计算管道数，然后添加一个以获取每个单元格中名称的数量。例如：单元格值为“Bob | Jon | Larry” = 2pipes +1 = 3 个名字。

我下面的代码有效，但我需要对数万条记录执行此操作。我不认为我的解决方案是一种好的或有效的方法（如果我错了，请告诉我）。所以我的问题是：

  1. 有没有更好的方法来实现这一点，例如不遍历范围内的每个单元格？

  2. 如果没有完全不同的方法，我怎样才能避免在新列的单元格中实际打印名称计数？我可以将这些值存储在一个数组中并计算数组的最大值吗？（也许您可以指出这个主题已经有一个线程？）

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
4

3 回答 3

4

最大子串数

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
于 2021-03-19T23:20:46.043 回答
3

接近公式的方法

结合工作表函数CountA()并FilterXML()允许获取由管道字符分隔的所有子字符串计数|：

Sub CountSubstrings(StartCell As Range, TargetRng As Range)
'Purp.: count items separated by pipes
'Meth.: via worksheetfunction FILTERXML()
'Note:  assumes target in same sheet as StartCell (could be changed easily)

'a) enter formula into entire target range
    Const PATTERN$ = _
        "=IF(LEN($),COUNTA(FILTERXML(""<t><s>""&SUBSTITUTE($,""|"",""</s><s>"")&""</s></t>"",""//s"")),0)"
    TargetRng.Formula2 = Replace(PATTERN, _
        "$", StartCell.Parent.Name & "!" & StartCell.Address(False, False))
'b) optional overwriting of formulae
    'TargetRng = TargetRng.Value
'c) display maximum result
    MsgBox Application.Max(TargetRng)

End Sub

提示：如果您想在公式分配中包含完全限定的工作簿 + 工作表引用，您甚至可以缩短代码如下。只需使用额外的参数External:=True（.Address例如导致类似的东西'[Test.xlsm]Sheet1'!A2）：

    TargetRng.Formula2 = Replace(PATTERN, _
        "$", StartCell.Address(False, False, External:=True))

可能的示例调用

    With Sheet1
        CountSubstrings .Range("A2"), .Range("D2:D5")
    End With

更多链接

Cf JvdV 的百科全书式网站展示了使用的各种可能性FilterXML()

于 2021-03-20T12:27:31.017 回答
1

VBasic2008 的精彩回答。我以为我会纯粹将其视为自己的编码练习。以下替代方案仅供参考。

Option Explicit

Sub CountMaxNames()
Dim arr1(), i, j, count As Long, tally As Long, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("leasing")

arr1 = ws.Range("O1:O" & ws.Range("O" & Rows.count).End(xlUp).Row)
count = 0: tally = 0

For Each i In arr1
    For j = 1 To Len(i)
        If Mid(i, j, 1) = "|" Then count = count + 1
    Next j
        count = count + 1
            If count >= tally Then tally = count
        count = 0
Next i

MsgBox "Maximum number of names in one cell is " & tally

End Sub
于 2021-03-20T06:09:06.927 回答