假设我在任意列中从第1行开始下载这些值:
1 A
2 A
3 A
4 A
5 B
6 B
7 B
8 A
9 A
10 A
我希望能够说start = 5是第一个B而last = 7是最后一个B.如果没有B的第一个和最后一个返回0。
答案 0 :(得分:12)
不要忘记,在VBA中,您仍然可以访问大量内置Excel功能。示例(假设您的数据在第1列中):
找到第一个B ...
Columns(1).Find(What:="B", LookAt:=xlWhole, MatchCase:=False).Row 'Returns 5
找到最后一个B ...
Columns(1).Find(What:="B", LookAt:=xlWhole, SearchDirection:=xlPrevious, MatchCase:=False).Row 'Returns 7
如果未找到B,则返回错误。如果找不到B,我们可以通过使用错误处理来返回0来利用这一点。把它们放在一起......
Sub DoTest()
Dim RowFirst As Integer, _
RowLast As Integer
On Error GoTo ErrorHandler
RowFirst = Columns(1).Find(What:="B", LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False).Row
RowLast = Columns(1).Find(What:="B", LookAt:=xlWhole, SearchDirection:=xlPrevious, MatchCase:=False).Row
Exit Sub
ErrorHandler:
RowFirst = 0
RowLast = 0
End Sub
答案 1 :(得分:3)
这样的事情对你有用还是需要两个独立的功能?
Function findValues(place As String, val As String, rng As Range) As Integer
Dim r As Range
findValues = 0
For Each r In rng
If InStr(r.Value2, val) > 0 Then
findValues = r.Row
If LCase(place) = "first" Then
Exit For
End If
End If
Next
End Function
像这样使用:
Dim rng As Range
Set rng = Range("B1:B10")
Dim i As Integer
i = findValues("first", "B", rng)
i = findValues("last", "B", rng)
根据您需要检查的范围的大小,这可能需要一段时间。
答案 2 :(得分:1)
这是另一种方式。
Sub FindFirstLast()
Dim vaValues As Variant
Dim vaFilter As Variant
Dim lFirst As Long
Dim lLast As Long
Const sFIND As String = "B"
With Application.WorksheetFunction
'Get a 1-d array from a column
vaValues = .Transpose(Sheet1.Range("A1:A10").Value)
'Use match to get the first instance
lFirst = .Match(sFIND, vaValues, False)
'Filter on the values
vaFilter = Filter(vaValues, sFIND)
'Assumes they're all together
lLast = lFirst + UBound(vaFilter)
End With
Debug.Print lFirst, lLast
End Sub
答案 3 :(得分:1)
我在一些应用程序中一直使用Kevin Pope的方法,但发现它有时会包含我不想要的东西。以为我会分享我的经验和解决方案。
最近我意识到如果我有这样的事情:
Mouser EPM1270GT144I5
Mouser EPM1270GT144I5
Mouser GRM32DR71E106K
Mouser GRM32DR71E106K
TTI GRM32DR71E106KA12L
Avnet GS816273CC-250I
Avnet GS816273CC-250I
并且正在寻找:GRM32DR71E106K
它会返回我正在搜索的两个,第三个以相同的字符串开头。
我需要适应搜索精确匹配。修复非常简单:
Public Function findValues(Val As String, Rng As Range, Optional place As Integer) As Integer
Dim R As Range
findValues = 0
For Each R In Rng
If StrComp(R.Value2, Val) = 0 Then
' If InStr(R.Value2, Val) > 0 Then
findValues = R.Row
If place = 1 Then
Exit For
End If
End If
Next
End Function
我希望有人觉得有用。