关于我的查找,我有一个问题,很可能是我错误地编写了代码。因此,如果我有数字810(即f),找到地址,再次810找到810其他位置的地址,依此类推......
然后我让前两个工作正常。因此,当findnext第一次以我想要的方式工作时,粘贴到最后一个单元格,但其他单元格不起作用。所以当我第二次找到下一个时,它不再复制和粘贴了。知道如何解决它吗?
With RgnScenarioScenario
Set f = .Find(What:=f, LookIn:=xlValues, LookAt:=xlWhole)
WsScenarios.Activate
f.Select
q = f.Address
Set x = Range("A:A").FindNext(f)
x.Select
z = x.Address
Set m = Range("A:A").FindNext(f)
m.Select
n = m.Address
Set k = Range("A:A").FindNext(f)
k.Select
w = k.Address
Set a = Range("A:A").FindNext(f)
a.Select
g = a.Address
If q <> z Then
Range(z).Offset(0, 5).Select
Range(ActiveCell, ActiveCell.Offset(0, ScenarioLastColumn - 6)).Copy
WsOutput.Activate
WsOutput.Cells(lLastRow, Columnf).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Else
End If
If z <> n Then
Range(n).Offset(0, 5).Select
Range(ActiveCell, ActiveCell.Offset(0, ScenarioLastColumn - 6)).Copy
WsOutput.Activate
WsOutput.Cells(lLastRow, Columnf).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Else
End If
If n <> w Then
Range(n).Offset(0, 5).Select
Range(ActiveCell, ActiveCell.Offset(0, ScenarioLastColumn - 5)).Copy
WsOutput.Activate
WsOutput.Cells(lLastRow, Columnf).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Else
End If
If w <> g Then
Range(n).Offset(0, 5).Select
Range(ActiveCell, ActiveCell.Offset(0, ScenarioLastColumn - 5)).Copy
WsOutput.Activate
WsOutput.Cells(lLastRow, Columnf).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Else
End If
End With
Next f
我的代码所寻找的是Scenario ID的范围值,在这种情况下是810.正如您在第一个打印屏幕中看到的那样,我有3次810.在下面只是标识2.这是问题所在,它应该是尽可能多地识别它。我在这件事上挣扎。我试过Autofilter,但没有解决我的问题。这完全与行动ID有关。有3个,所以,我的代码应该带3个
答案 0 :(得分:4)
附件是&#39; FindAll&#39;您可能可以使用的功能吗?
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: Set 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