Question

我有产品代码:(它们在活动表的C列中）

DO-001
DO-002
DO-003
DO-004

我有大量数据:(它们位于“Sheet1”的C列）

41300100_DO-001_14215171
41300104_DO-001_14215173
K1_ISK_41300661_DO-002_13190369
NP_41533258_DO-003_14910884
DO-003_DD_44_ddd

我想计算产品代码出现在数据列表中的次数。因此，这种情况的结果是:(结果是活动表的H列）

DO-001   2
DO-002   1
DO-003   2
DO-004

我用这段代码完成了这个：

Sub CountcodesPLC()
    Dim i, j As Integer, icount As Integer
    Dim ldata, lcodes As Long

    icount = 0

    lcodes = Cells(Rows.Count, 3).End(xlUp).Row
    ldata = Worksheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Row

    For i = 10 To lcodes
        For j = 2 To ldata
            If InStr(Worksheets("Sheet1").Range("C" & j), Range("C" & i)) <> 0 Then
                icount = icount + 1
            End If
        Next j

        If icount <> 0 Then
            Range("H" & i).Value = icount
        End If

       icount = 0
    Next i
End Sub

但我想改变它，所以如果数据列表包含一些关键词，如“NP”，“ISK”，那么不计算它们，或者如果数据的第一部分是代码那么也不是计算它们，所以这个例子的结果是：

DO-001   2
DO-002 
DO-003 
DO-004

此外，我将拥有大约1.000个产品代码和大约60,000个数据字符串。我的代码会崩溃吗？

Answer 1

似乎你的代码没问题。但是如果你只想匹配字符串的第一部分（a'ka StartsWith），我只会改变这一行：

If InStr(Worksheets("Sheet1").Range("C" & j), Range("C" & i)) <> 0 Then

为：

If Worksheets("Sheet1").Range("C" & j) Like Range("C" & i) & "*" Then

有关详细信息，请参阅：Wildcard Characters used in String Comparisons

Answer 2

使用Dictionnary

Dim Dict As Scripting.Dictionary
Set Dict = New Scripting.Dictionary

Arr = Split("refer your text here", "_")

For I = LBound(Arr) To UBound(Arr)
    If Dict.Exists(Arr(I)) Then
        Dict(Arr(I)) = Dict(Arr(I)) + 1 'increment
    Else
        Dict.Add Arr(I), 1
    End If
Next I

Answer 3

这可能是OTT的要求，但应该很快。

Public Sub Sample()
Dim WkSht       As Worksheet
Dim LngRow      As Long
Dim AryLookup() As String
Dim VntItem     As Variant

'We put what we want to search into an array, this makes it a lot quicker to search
Set WkSht = ThisWorkbook.Worksheets("Sheet1")
    ReDim AryLookup(0)
    LngRow = 1
    Do Until WkSht.Range("A" & LngRow) = ""
        If AryLookup(UBound(AryLookup, 1)) <> "" Then ReDim Preserve AryLookup(UBound(AryLookup, 1) + 1)
        AryLookup(UBound(AryLookup, 1)) = Trim(UCase(WkSht.Range("A" & LngRow)))
        LngRow = LngRow + 1
    Loop
Set WkSht = Nothing

'Then we go down the list and check the array against each item
Set WkSht = ActiveSheet
    LngRow = 1
    Do Until WkSht.Range("A" & LngRow) = ""
        WkSht.Range("B" & LngRow) = 0
        For Each VntItem In AryLookup()

            'This looks for the match without any of the exclusion items
            If (InStr(1, VntItem, Trim(UCase(WkSht.Range("A" & LngRow)))) <> 0) And _
                (InStr(1, VntItem, "NP") = 0) And _
                (InStr(1, VntItem, "ISK") = 0) Then
                WkSht.Range("B" & LngRow) = WkSht.Range("B" & LngRow) + 1
            End If
        Next
        LngRow = LngRow + 1
    Loop
Set WkSht = Nothing

MsgBox "Done"

End Sub

基本上，60,000个数据字符串将进入内存中的数组，然后将针对1,000个产品搜索该数组。在内存中搜索应该很快。

我要提出的一件事是排除方法可能会产生误报。

例如，排除NP将排除： -

NP_41533258_DO-003_14910884

NPA_41533258_DO-003_14910884

41533258_ANP_DO-003_14910884

您可能想要考虑整体方法。

Answer 4

你有没有考虑过一个数组公式，不确定它对代码的执行方式，但是，你可以在这些行上做一些事情，其中list在A中，而prod数字在B中

=SUM(IF(NOT(ISERR(SEARCH(B1 & "_",$A$1:$A$5,1)))*(ISERR(SEARCH("NP_",$A$1:$A$5,1))),1,0))

其中＆＃34; NP＆＃34;将被包含排除的范围所取代，我将其作为NP来显示正在发生的事情。

Answer 5

代码就像这样。但我不知道速度。

Sub test()
    Dim vDB, vLook, vSum(), Sum As Long
    Dim Ws As Worksheet, dbWs As Worksheet
    Dim s As String, sF As String, sCode As String
    Dim i As Long, j As Long, n As Long

    Set dbWs = Sheets("Sheet1")
    Set Ws = ActiveSheet

    With Ws
        vLook = .Range("a1", .Range("a" & Rows.Count).End(xlUp))
    End With
    With dbWs
        vDB = .Range("c1", .Range("c" & Rows.Count).End(xlUp))
    End With

    n = UBound(vLook, 1)

    ReDim vSum(1 To n, 1 To 1)
    For i = 1 To n
        sF = Split(vLook(i, 1), "-")(0)
        sCode = Replace(vLook(i, 1), sF, "")
        Sum = 0
        For j = 1 To UBound(vDB, 1)
            s = vDB(j, 1)
            If Left(s, Len(sF)) = sF Or InStr(s, "NP") Or InStr(s, "ISK") Then
            Else
                If InStr(s, sCode) Then
                    Sum = Sum + 1
                End If
            End If
        Next j
        If Sum > 0 Then
            vSum(i, 1) = Sum
        End If
    Next i
    Ws.Range("h1").Resize(n) = vSum

End Sub

使用VBA计算字符串中的字符串

5 个答案: