使用在VBA单元格公式中存储为变量的选择

时间:2019-06-19 21:47:39

标签: excel vba

我正在尝试使用一个选定的范围(基于用户输入是有条件的),该范围作为变量存储在VBA生成的单元格公式中。

在消息框中使用myCells.Address值时,可以看到该变量正确存储了所选范围。但是,当我尝试将其插入通过VBA代码创建的单元格公式中时,我会收到类型不匹配错误(作为范围存储时),或者在存储为字符串时遇到对象所需的错误。

我尝试将myCells变量中存储的范围转换为要在.formula中使用的字符串或范围,但似乎都不可接受,

Sub Calculate_Average()

Dim ws As Worksheet
Dim sSheet As String
Dim Year As Range
Dim myCells As Range
Dim Repairer As Range
Dim range2 As Range

Set ws = ActiveWorkbook.Sheets("Sheet1")
Set Year = ws.Range("$c$5:$s$5")
Set Repairer = ws.Range("$b$8:$b$52")


sSheet = InputBox( _
Prompt:="Enter current month in format mmm-yy", _
Title:="Input Month")

        If sSheet = "May-19" Then GoTo loopexit ''debug
        If sSheet = "Jun-19" Then GoTo loopexit ''debug


'' loop through cells in Year range to find matching date

For Each Cell In Year

        Cell.Select ''debug

        If ActiveCell.Value = sSheet Then
            ActiveCell.Offset(1, -2).Select
            Selection.Resize(Selection.Rows.Count, Selection.Columns.Count + 2).Select
            Set myCells = Selection
            MsgBox (myCells.Address)
            ws.Range("B6").Formula = "=AVERAGE(" & myCells.Address & ")"
            ActiveCell.Copy
            Repairer.Select
            PasteSpecial xlPasteFormulas
            GoTo loopexit
        Else
            MsgBox ("error") ''debug
        End If
Next Cell
loopexit: ''debug

End Sub

该公式输入到单元格b6中,其外观应类似于= average($ c6:$ E6),然后将其复制到b $ 8:$ b $ 53范围内,以进行调整以反映行中的更改。

2 个答案:

答案 0 :(得分:0)

解决了我的问题。

可能不是最好的解决方案,但它可以工作。之后修改公式以删除单元格锁定功能。然后使用另一种方法复制到修复范围内的细胞中。

Sub Calculate_Average()

Dim ws As Worksheet
Dim sSheet As String
Dim Year As Range
Dim myCells As Range
Dim Repairer As Range
Dim range2 As Range
Dim FindRng As Range

Set ws = ActiveWorkbook.Sheets("Sheet1")
Set Year = ws.Range("$c$5:$s$5")
Set Repairer = ws.Range("b8:b52")


sSheet = InputBox( _
Prompt:="Enter current month in format mmm-yy", _
Title:="Input Month")

        If sSheet = "May-19" Then GoTo loopexit ''debug
        If sSheet = "Jun-19" Then GoTo loopexit ''debug


'' loop through cells in Year range to find matching date

Set FindRng = Year.Find(What:=sSheet, LookIn:=xlValues, lookat:=xlWhole)

If Not FindRng Is Nothing Then ' see that find was successful
    FindRng.Select

        If ActiveCell.Value = sSheet Then
            ActiveCell.Offset(1, -2).Select
            Selection.Resize(Selection.Rows.Count, Selection.Columns.Count + 2).Select
            Set myCells = Selection
            MsgBox (myCells.Address)
            ws.Range("B6").Formula = "=AVERAGE(" & myCells.Address & ")"
            Range("B6").Select
            ActiveCell.FormulaR1C1 = "=AVERAGE(RC4:RC6)"
            Range("B6").Select
            Selection.AutoFill Destination:=Range("B6:B52")
            Range("B6:B52").Select

            GoTo loopexit
        Else
    MsgBox "Error, unable to match", vbCritical
        End If
        End If

loopexit: ''debug

End Sub

答案 1 :(得分:0)

不确定我是否在这里遗漏了一些东西,但是您不需要循环。您可以一次性创建公式,然后将其复制并粘贴为值:

With Range("B6:B52")
    .Formula = "=average(C6:E6)" 'Excel is smart enough to increase this per row
    .Copy
    .PasteSpecial xlPasteValues
end with

没有选择,也没有循环。