Question

我正在努力解决下一个问题的起点。基本上，我需要能够在整个电子表格中搜索唯一的13位数字（这是未知的，所以我不能事先引用它），找到对该数字的所有引用，将行复制到新的工作表中然后查找下一个13位数字，直到所有不同的13位数字参考都被复制到新的工作表中。现在这个数字可能在A / B列中，但也可能没有，我们没有给出设置模板中的数据，这就是为什么它需要搜索整个电子表格。任何人都可以给我一个关于从哪里开始的想法？如果事先知道数字，我有一个子程序的基础，但在这种情况下，我们不知道这些数字只是他们在那里。请帮忙？！这是我需要的VBA解决方案。 Sample Data

现在唯一的数字可能并不总是在B列中，这就是为什么宏需要能够在复制与之相关的所有行之前识别13位数字所在的列。我希望这更有意义。

Answer 1

这是一个通用的FindAll函数，它可以作为一个开始。您需要指定一个区域（例如.UsedRange）进行搜索以及您要搜索的内容，它将返回所有匹配的单元格的范围。

Function FindAll(What, _
    Optional SearchWhat As Variant, _
    Optional LookIn, _
    Optional LookAt, _
    Optional SearchOrder, _
    Optional SearchDirection As XlSearchDirection = xlNext, _
    Optional MatchCase As Boolean = False, _
    Optional MatchByte, _
    Optional SearchFormat) As Range

    'LookIn can be xlValues or xlFormulas, _
     LookAt can be xlWhole or xlPart, _
     SearchOrder can be xlByRows or xlByColumns, _
     SearchDirection can be xlNext, xlPrevious, _
     MatchCase, MatchByte, and SearchFormat can be True or False. _
     Before using SearchFormat = True, specify the appropriate settings for the Application.FindFormat _
     object; e.g. Application.FindFormat.NumberFormat = "General;-General;""-"""

    Dim SrcRange As Range
    If IsMissing(SearchWhat) Then
        Set SrcRange = ActiveSheet.UsedRange
    ElseIf TypeOf SearchWhat Is Range Then
        Set SrcRange = IIf(SearchWhat.Cells.Count = 1, SearchWhat.Parent.UsedRange, SearchWhat)
    ElseIf TypeOf SearchWhat Is Worksheet Then
        Set SrcRange = SearchWhat.UsedRange
    Else: SrcRange = ActiveSheet.UsedRange
    End If
    If SrcRange Is Nothing Then Exit Function

    'get the first matching cell in the range first
    With SrcRange.Areas(SrcRange.Areas.Count)
        Dim FirstCell As Range: Set FirstCell = .Cells(.Cells.Count)
    End With

    Dim CurrRange As Range: Set CurrRange = SrcRange.Find(What:=What, After:=FirstCell, LookIn:=LookIn, LookAt:=LookAt, _
        SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)

    If Not CurrRange Is Nothing Then
        Set FindAll = CurrRange
        Do
            Set CurrRange = SrcRange.Find(What:=What, After:=CurrRange, LookIn:=LookIn, LookAt:=LookAt, _
            SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)
            If CurrRange Is Nothing Then Exit Do
            If Application.Intersect(FindAll, CurrRange) Is Nothing Then
                Set FindAll = Application.Union(FindAll, CurrRange)
            Else: Exit Do
            End If
        Loop
    End If
End Function

搜索电子表格的所有列以获取唯一值

1 个答案: