我正在为下一个问题的起点而苦苦挣扎。从本质上讲，我需要能够在整个电子表格中搜索唯一的 13 位数字（这是未知的，因此我无法事先引用它），找到对该数字的所有引用，将行复制到新的工作表中，然后然后查找下一个 13 位数字，直到所有不同的 13 位参考都已复制到新工作表中。现在这个数字可能在 A/B 列中，但也可能不在，我们没有在设置模板中提供数据，这就是为什么它需要搜索整个电子表格。谁能给我一个从哪里开始的想法？如果我事先知道数字，我就有一个子程序的基础，但在这种情况下，我们不知道这些数字，只是因为它们在那里。请帮忙？！这是我需要的 VBA 解决方案。样本数据
现在唯一编号可能并不总是在 B 列中，这就是为什么宏需要能够在复制与其相关的所有行之前识别 13 位数字所在的列。我希望这更有意义。
这是一个可以作为开始的通用 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
本文收集自互联网，转载请注明来源。
如有侵权，请联系 [email protected] 删除。
我来说两句