Question

我有以下代码根据工作表名称添加相同的单元格，这是代码：

Sub Addem()
Dim ws As Worksheet
x = 0
For Each ws In Worksheets
If ws.Name Like "*Fvar" Then
    x = x + ws.Range("G12").Value
End If
Next ws
Sheets("Summary-Fvar2").Range("G12").Value = x
End Sub

如何格式化此宏以将其分别应用于多个单元格位置？（H12，N12，H33，N33等......）

当我尝试定义范围名称并添加所有单元格位置时，我想将它应用于该范围内的每个单元格。

Answer 1

如果您想单独添加单元格，可以在数组中循环，即

Sub Addem()

Dim ws As Worksheet, x() As Long, v, i As Long

v = Array("G12", "H12", "N12", "H33", "N33") 'amend to suit
ReDim x(UBound(v))

For Each ws In Worksheets
    If ws.Name Like "*Fvar" Then
        For i = LBound(v) To UBound(v)
            x(i) = x(i) + ws.Range(v(i)).Value
        Next i
    End If
Next ws

For i = LBound(v) To UBound(v)
    Sheets("Summary-Fvar2").Range(v(i)).Value = x(i)
Next i

End Sub

Answer 2

我会应用这样的公式。此代码替换了您的Sub Addem

Sub AddCell(ByVal myCell As String, ByVal target As Range, ByVal pattern As String)

    Dim ws As Worksheet
    Dim myFormula As String

        For Each ws In Worksheets
            If ws.Name Like pattern Then
                myFormula = myFormula & ws.Name & "!" & myCell & ","
            End If
        Next

        myFormula = Left(myFormula, Len(myFormula) - 1)
        target.Formula = "=SUM(" & myFormula & ")"

End Sub

Sub TestIt()
     AddCell "G12", Sheets("Summary-Fvar2").Range("G12"), "Fav*"    
End Sub

下一个代码是针对一组单元格

Sub AddCellV(ByVal vCell As Variant, ByVal target As Range, ByVal pattern As String)
            Dim ws As Worksheet

        Dim myFormula As String
        Dim i As Long
            For i = LBound(vCell) To UBound(vCell)
                For Each ws In Worksheets
                    If ws.Name Like pattern Then
                        myFormula = myFormula & ws.Name & "!" & vCell(i) & ","
                    End If
                Next
            Next

            myFormula = Left(myFormula, Len(myFormula) - 1)
            target.Formula = "=SUM(" & myFormula & ")"

End Sub

Sub TestIt()                
      AddCellV Array("G12", "H12", "N12", "H33", "N33"), Sheets("Summary-Fvar2").Range("G12"), "Fav*"                
End Sub

TO AddCell的评论需要多次应用

Sub AddCellMultiple(ByVal vCell As Variant, _
                            ByVal targetSh As Worksheet, _
                            ByVal pattern As String)

    Dim i As Long
    For i = LBound(vCell) To UBound(vCell)
        AddCell vCell(i), targetSh.Range(vCell(i)), pattern
    Next

End Sub


Sub TestMultiple()
    AddCellMultiple Array("G12", "H12", "N12", "H33", "N33"), Sheets("Summary-Fvar2"), "Fav*"
End Sub

如何将一个单元格的宏应用于多个单元格

2 个答案: