Excel VBA中的計數搜索結果

我前幾天問關於同一工作簿中的問題，它在這裏：Excel countif vba code with criteria resulting with values 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

修改後的代碼，我看不出有任何遺漏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

來源

2013-10-14 lowak

嗯，不知何故，我不明白這個問題。你可以嘗試重新措辭，並使我的目的更清楚嗎？ – Trace

像這樣的事情

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

來源

2013-10-14 09:36:21 brettdj

呃...有點問題。代碼在使用一個範圍時工作正常，但是我有15個範圍。所以我複製了你的代碼，改變了範圍，在'if-statements'中的偏移量等等。不幸的是它說「結束沒有與」 - 我檢查代碼，一切都看起來不錯。再一次，當我將它複製到新的宏時，你的代碼就可以正常工作。當重做多個範圍時顯示錯誤信息。 – lowak

這將有助於瞭解如何修改代碼。聽起來像你錯過了當你改變它時添加'End With'。 – brettdj

爲問題添加代碼，錯誤首先顯示在pp2dni2008範圍的'end with'中。 – lowak

Excel VBA中的計數搜索結果

回答

相關問題