循环单元格并对每个单元格应用一个函数——无需重复太多代码

Question

我正在为 VBA 中的 Excel（2016 - 但我可以争取较新的版本）项目。

---

我在这里找到了这个相关主题：excel vba: Special Types - Functions as Arguments of Functions，但我对它的理解还不够好，无法实现它。还有这个：https://codereview.stackexchange.com/questions/138557/functional-framework，目前在我的脑海中。如果需要的话，我可以努力学习这些主题，但我可能需要有人帮助解释它们如何更好地工作。

---

我发现自己经常一遍又一遍地编写同一组代码：

Sub SpecificProcess()
     Dim c as Range
     Dim selectedRange as Range
     Set selectedRange = Application.Selection

     For Each c in selectedRange.Cells
          'Do some stuff to the cell
     Next c
End Sub

问题是我需要一直重复：

Sub Add1toValue()
End Sub

Sub ChangeColorToX()
End Sub

Sub CountFingersAndToes()
End Sub

Sub Foo()
End Sub

等等。每一个都有一个共同的因素：“对选择中的每个单元格做一些事情。代码闻起来很糟糕。尤其是如果我不小心把循环搞砸了。

---

如果是 python，我会做如下的事情：

注意：有一段时间我真的很喜欢学习 python，所以我对中级编码实践有一些了解——但我已经有 15 年左右没有使用它了（3.1 更新？），所有这些记忆都是锁起来，VBA 是一个非常不同的野兽。但是如果有人可以开始解释某些东西如何在 VBA 中工作，我可能会理解它。

'PseudoPython Code 
Function Looper( f as function, *args, **kwargs )
     selectedRange = Selection.range()
     
     for c in selectedRange
          f(c, *args, **kwargs)
     next c

Function f_Sample(c as cell, arg1, arg2, ... kwarg1, kwarg2)
     c.SpecificProcesses(arg_n, kwarg_n)

if __init__=="__main__"
     `select cells
     `add one to each cell, change the color, and foobar, in order
     makeSelection()
     Looper(f_addone, n_times)
     Looper(f_changeColor, "RoyGBiv")
     Looper(f_foobar, "spamspamspam")
'Note: maybe Looper would be a decorator in python?

结果是它会迭代地对选择中的每个单元格执行这些功能，而我不必一遍又一遍地编写循环结构。

我什至可以扩展它来制作 LoopOverCells、LoopOverWorkSheets、LoopOverSpams 等等。

---

以正确编码的方式处理此问题的最佳方法是什么 - 但仅限于 VBA / EXCEL 领域。

Answer 1

您可以执行以下操作并使用Application.Run 按名称调用过程。缺点是您必须使用ParamArray 来提交参数，并且您不能在过程中指定每个参数。因此，您需要为希望确保正确数据类型的每个参数声明一个变量。

您可能需要对参数进行一些错误处理，这取决于您要返回多少信息或只是让它运行到异常中（CheckArguments 部分不一定需要，但在"ChangeColorToX", 1, 5 的情况下参数比需要的多，您可能想知道为什么 5 如果不检查参数和错误就不起作用）。

Option Explicit
    
Public Sub Example()
    DoSomethingToEveryCellInSelection "AddXAndYtoValue", 1, 5
    
    DoSomethingToEveryCellInSelection "ChangeColorToX", RGB(255, 255, 0)

    DoSomethingToEveryCellInSelection "AddXAndYtoValue", "A", "B" ' correct amount of argument but wrong datatype
    DoSomethingToEveryCellInSelection "ChangeColorToX", 1, 5  ' wrong amount of arguments
End Sub

Public Sub DoSomethingToEveryCellInSelection(ByVal ProcedureName As String, ParamArray Args() As Variant)
    Dim c As Range
    Dim selectedRange As Range
    Set selectedRange = Application.Selection

    For Each c In selectedRange.Cells
        Application.Run ProcedureName, c, Args
    Next c
End Sub

Private Sub AddXAndYtoValue(ByVal Cell As Range, ByRef Args() As Variant)
    ' maybe some error checking for the amount of parameters
    CheckArguments "AddXAndYtoValue", 2, Args ' we expect 2 arguments
    
    ' we need to define variables for each argument to ensure that we have the correct data type
    ' if we don't do that the code might concatenate in case we submit strings as arguments
    ' in other cases other things might go wrong
    
    Dim x As Double
    x = Args(0)
    
    Dim y As Double
    y = Args(1)
    
    Cell.Value = Cell.Value + Args(0) + Args(1)
End Sub

Private Sub ChangeColorToX(ByVal Cell As Range, ByRef Args() As Variant)
    ' maybe some error checking for the amount of parameters
    CheckArguments "ChangeColorToX", 1, Args ' we expect 1 argument
    
    Dim Color As Variant
    Color = Args(0)
    
    Cell.Interior.Color = Color
End Sub

Private Sub CheckArguments(ByVal ProcedureName As String, ByVal ArgsNo As Long, ByRef Args() As Variant)
    ' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/raise-method
    If UBound(Args) <> ArgsNo - 1 Then
        ' raise an error that the function needs 2 parameters
        Err.Raise vbObjectError + 1, ProcedureName , "Wrong amount of parameters."
    End If
End Sub