1

几天前,我问了与同一工作簿有关的问题,它在这里:Excel countif vba code with criteria results 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
4

1 回答 1

2

像这样的东西

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-14T09:36:21.443 回答