Excel VBA统计search结果

几天前，我问了有关同一个工作簿的问题，它在这里： Excel countif vba代码与标准结果值

所以…我得到了下面的代码。 基本上，它search给定范围内的值，并检查另一个单元格中的某个值 – 然后“计数”。 至less它应该计数，但它只是input1到单元格中。

它工作的很好，但是在给定的范围内可能有多个search结果。 我尝试使用.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 

修改后的代码，我没有看到任何遗漏with标签。

 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 

Answer 1

像这样的东西

 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