Excel vba计数搜索结果

几天前，我问了一个关于同一个工作簿的问题，它在这里：

所以。。。我得到了下面的密码。基本上，它在给定范围内搜索一个值，并在另一个单元格中检查某个值，然后“计数”。至少它应该计数，但它只是在单元格中输入1

它工作得很好，但是在给定范围内可能有多个搜索结果。我试着使用

.findnext

，但它没有按我所希望的那样工作。我还尝试添加另一个

.find

，但仍然失败

如何应对

Sub Wstaw_Szkolenia()

Dim MyRange As Range, MyCell As Variant

Range("A1").Select

liczba = 6

Set MyRange = Range(Selection, Selection.End(xlDown)).Rows.SpecialCells(xlCellTypeVisible)

'PP 2dni 2007
For Each MyCell In MyRange.Cells
    With Range("pp2dni2007")
         If .Cells.Find(MyCell.Value) Is Nothing Then

        Else
            If .Cells.Find(MyCell.Value).Offset(0, 3).Value = "TAK" Then
            MyCell.Offset(0, liczba).Value = 1

            Else
            MyCell.Offset(0, liczba).Value = 0

            End If

        End If

    End With
Next

(...)same code, different range(...)

End Sub

已修改代码，我没有看到任何带有标记的

缺失

Sub Wstaw_Szkolenia()

Dim MyRange As Range
Dim rng1 As Range
Dim MyCell As Variant
Dim strAddress As String

liczba = 6

Set MyRange = Range([a1], [a1].End(xlDown)).Rows.SpecialCells(xlCellTypeVisible)

'PP 2dni 2007
For Each MyCell In MyRange.Cells
    With Range("pp2dni2007")
    Set rng1 = .Cells.Find(MyCell.Value)
        If Not rng1 Is Nothing Then

        strAddress = rng1.Address
        Do

            If .Cells.Find(MyCell.Value).Offset(0, 3).Value = "TAK" Then
            MyCell.Offset(0, liczba).Value = MyCell.Offset(0, liczba).Value + 1

            Else
            MyCell.Offset(0, liczba).Value = 0

            End If

        Set rng1 = .Cells.FindNext(rng1)
        Loop While rng1.Address <> strAddress

        End If

    End With

Next


'PP 3dni 2008
For Each MyCell In MyRange.Cells
    With Range("pp3dni2008")
    Set rng1 = .Cells.Find(MyCell.Value)
        If Not rng1 Is Nothing Then

        strAddress = rng1.Address
        Do

            If .Cells.Find(MyCell.Value).Offset(0, 3).Value = "TAK" Then
            MyCell.Offset(0, liczba + 1).Value = MyCell.Offset(0, liczba + 1).Value + 1

            Else
            MyCell.Offset(0, liczba + 1).Value = 0

            End If

        Set rng1 = .Cells.FindNext(rng1)
        Loop While rng1.Address <> strAddress

    End With
Next

(...and repeats for different ranges...)

End Sub

Sub-Wstaw_Szkolenia（）
将MyRange变暗为Range
变暗rng1 As范围
作为变种的暗菌丝体
她穿得像绳子
liczba=6
设置MyRange=Range（[a1]，[a1].End（xlDown））.Rows.SpecialCells（xlCellTypeVisible）
第2dni页2007
对于MyRange.Cells中的每个菌丝体
范围（“pp2dni2007”）
Set rng1=.Cells.Find（MyCell.Value）
如果不是，那么rng1什么都不是
strAddress=rng1.地址
做
如果.Cells.Find（MyCell.Value）.Offset（0,3）.Value=“TAK”，则
MyCell.Offset（0，liczba）.Value=MyCell.Offset（0，liczba）.Value+1
其他的
MyCell.Offset（0，liczba）.Value=0
如果结束
设置rng1=.Cells.FindNext（rng1）
在rng1时循环。地址
如果结束
以
下一个
'PP 3dni 2008
对于MyRange.Cells中的每个菌丝体
范围（“pp3dni2008”）
Set rng1=.Cells.Find（MyCell.Value）
如果不是，那么rng1什么都不是
strAddress=rng1.地址
做
如果.Cells.Find（MyCell.Value）.Offset（0,3）.Value=“TAK”，则
MyCell.Offset（0，liczba+1）.Value=MyCell.Offset（0，liczba+1）.Value+1
其他的
迈塞尔偏移量（0，liczba+1）。值=0
如果结束
设置rng1=.Cells.FindNext（rng1）
在rng1时循环。地址
以
下一个
（…并针对不同范围重复…）
端接头
类似这样的东西

Sub Kransky()

Dim MyRange As Range
Dim rng1 As Range
Dim MyCell As Variant
Dim strAddress As String

liczba = 6
Set MyRange = Range([a1], [a1].End(xlDown)).Rows.SpecialCells(xlCellTypeVisible)


For Each MyCell In MyRange.Cells
    With Range("pp2dni2007")
   Set rng1 = .Cells.Find(MyCell.Value)
   If Not rng1 Is Nothing Then
   strAddress = rng1.Address
   Do
            If .Cells.Find(MyCell.Value).Offset(0, 3).Value = "TAK" Then
            MyCell.Offset(0, liczba).Value = MyCell.Offset(0, liczba).Value + 1
            Else
            MyCell.Offset(0, liczba).Value = 0
            End If
    Set rng1 = .Cells.FindNext(rng1)
    Loop While rng1.Address <> strAddress
    End If
    End With
Next

End Sub

Sub-Kransky（）
将MyRange变暗为Range
变暗rng1 As范围
作为变种的暗菌丝体
她穿得像绳子
liczba=6
设置MyRange=Range（[a1]，[a1].End（xlDown））.Rows.SpecialCells（xlCellTypeVisible）
对于MyRange.Cells中的每个菌丝体
范围（“pp2dni2007”）
Set rng1=.Cells.Find（MyCell.Value）
如果不是，那么rng1什么都不是
strAddress=rng1.地址
做
如果.Cells.Find（MyCell.Value）.Offset（0,3）.Value=“TAK”，则
MyCell.Offset（0，liczba）.Value=MyCell.Offset（0，liczba）.Value+1
其他的
MyCell.Offset（0，liczba）.Value=0
如果结束
设置rng1=.Cells.FindNext（rng1）
在rng1时循环。地址
如果结束
以
下一个
端接头
Hm，不知为什么我不明白这个问题。你能试着重新措辞，让我更清楚地了解目的吗？嗯。。。有点小问题。代码在用于一个范围时运行良好，但我得到了大约15个范围。所以我复制了您的代码，更改了
if语句中的范围和偏移量等。不幸的是，它说“结束于无”-我检查了代码，一切看起来都正常。再一次，当我将它复制到新宏中时，您的代码本身就可以正常工作。当对多个范围进行返工时，将显示错误消息。这将有助于查看您如何修改代码。听起来您在更改时错过了添加
以
结尾。在问题中添加了代码，错误首先显示在pp2dni2008范围内的
以
结尾。好的，我发现缺少
以
结尾，现在效果很好。谢谢brettdj:）