Question

我有一个宏来检查过滤列结果的每个单元格。它检查14个不同的范围。我想知道，有可能以某种方式削减我的代码，所以我不必将相同的指令复制/粘贴到不同的范围？我正在考虑使用字典，但我不确定这是一个很好的解决方案，而且不知道如何混合每个检查不同的范围并在不同的地方插入结果。下面我给你一个代码：

Sub check_training()

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

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

            If Not IsEmpty(MyCell.Offset(0, liczba).Value) Then

            Else

                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 If

    End With

Next


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

            If Not IsEmpty(MyCell.Offset(0, liczba).Value) Then

            Else

                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 If

    End With
Next

(and so on...)

End sub

Answer 1

使用您将复制粘贴的代码定义一个sub，然后将变量factor作为参数传递给该函数。反过来，使用所有必要的字符串调用该函数。我不得不承认，我无法理解您的代码，但我已尽力提取函数

Public Sub rangeOperation(MyRange as Range, rangeString as String, liczba as Integer)
    Dim rng1 As Range
    Dim MyCell As Variant
    Dim strAddress As String

    For Each MyCell In MyRange.Cells
        With Range(rangeString)
        Set rng1 = .Cells.Find(MyCell.Value)
            If Not rng1 Is Nothing Then
                If Not IsEmpty(MyCell.Offset(0, liczba).Value) Then

            Else
                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 If
        End With
    Next
End Sub

然后，您可以从现在的代码中调用此函数：

Dim MyRange as Range
dim rangeString as String
dim liczba as Integer

Set MyRange = Range([a1], [a1].End(xlDown)).Rows.SpecialCells(xlCellTypeVisible)
rangeString = "pp2dni2007"
liczba = 0 ' or whatever value...

Call rangeOperation(MyRange, rangeString, liczba)

liczba = liczba + 1
rangeString = "pp3dni2008"

Call rangeOperation(MyRange, rangeString, liczba)

等。由于我不知道你的功能是什么，你必须找出需要更多变量的其他部分。接下来的步骤是将字符串放在某种集合/字典/数组中并循环遍历该数据结构，从循环内调用该函数。

对于每个具有不同范围的细胞？

1 个答案: