时间戳

首页 > 解决方案 > 将匹配限制为三个而不是无限

excel - 将匹配限制为三个而不是无限

问题描述

我正在使用脚本根据另一列（图像文件名，其中包含项目#）匹配一列（项目＃）。我将匹配的结果放在中间列中，每个匹配项用;分隔符分隔。

Sub Adrift()
    Dim NA As Long, NC As Long, v As String, I As Long, J As Long
    Dim v2 As String
    NA = Cells(Rows.Count, "A").End(xlUp).Row
    NC = Cells(Rows.Count, "C").End(xlUp).Row
    For I = 2 To NA
        v = Cells(I, "A").Value
        v2 = ""
        For J = 2 To NC
            If InStr(Cells(J, "C").Value, v) > 0 Then
                v2 = v2 & "," & Cells(J, "C").Value
            End If
        Next J
        Cells(I, "A").Offset(0, 1).Value = Mid(v2,2)
    Next I
End Sub

我每个项目最多有 30 张图像 # 并且希望将此脚本限制为 3 或 4 个匹配项。

编辑：

假设我们有一个工作表，例如：

在此处输入图像描述

上面的脚本扫描 A 列（AMH4613A、AMH5706B 等），然后根据 A 列的值扫描 C 列（注意图像使 C 列看起来是 B 列）。如果存在匹配项（或来自A 列出现在 C 列值的某些部分） C 列中的文件名或值与 B 列中的匹配项 # 相邻​​放置。

注意C 列很长，它是一个目录中所有图像的列表。A 列（项目编号）大约有 1000 行长，而 C 列大约有 5000 行。所以平均每个项目大约有 5 张图像，但并非总是如此。

输出如下：

在此处输入图像描述

标签： excelvba

解决方案

我可能会用 finds 做这样的事情 - 也应该让它更快。

Sub Adrift()
Dim NA As Long, NC As Long, I As Long
Dim Finder As Range, FAdd As String, Count As Integer
NA = Cells(Rows.Count, "A").End(xlUp).Row
NC = Cells(Rows.Count, "C").End(xlUp).Row
For I = 2 To NA
    Count = 0: Cells(I, "B").Value = ""
    Set Finder = Range("C1:C" & NC).Find(Cells(I, "A").Value, LookAt:=xlPart)
    If Not Finder Is Nothing Then
        FAdd = Finder.Address
        Do
            Cells(I, "B").Value = Cells(I, "B").Value & "," & Finder.Value
            Count = Count + 1
            Set Finder = Range("C1:C" & NC).FindNext(Finder)
        Loop While Finder.Address <> FAdd And Count < 3
        Cells(I, "B").Value = Mid(Cells(I, "B").Value, 2)
    End If
Next I
End Sub

您可能会丢失 count 变量而只计算字符串中的逗号 - 您可以将其存储为字符串而不是将其反复放入单元格中 - 如果速度是一个问题，它也可能会使其更快。

当然，变体数组通常比查找更快，尽管 IMO 它是查找的一个不错的用例。

推荐阅读