Question

前几天我问过同一个工作簿的问题，就在这里：Excel countif vba code with criteria resulting with values

所以...我得到了下面的代码。基本上它搜索给定范围内的值并检查另一个单元格中的某个值 - 然后“计数”。至少它应该是重要的，但它只是输入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

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

Excel vba计算搜索结果

1 个答案: