對於具有不同範圍的每個細胞？

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

定義你會以其他方式複製粘貼代碼子，然後傳遞變量因素作爲參數傳遞給該功能。反過來，用所有必要的字符串調用該函數。我不得不承認，我無法使你的代碼的任何意義，但我已經盡我所能提取功能

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) 

等等因爲我不知道你的函數做了什麼，你必須弄清楚其他需要更多變量的部分。接下來的步驟是把你的字符串放在某種集合/字典/數組中，並循環該數據結構，從循環中調用該函數。