Используя выбор, сохраненный как переменная в формуле ячейки VBA - PullRequest
0 голосов
/ 20 июня 2019

Я пытаюсь использовать выбранный диапазон (который является условным на основе пользовательского ввода), который сохраняется как переменная в формуле ячейки, сгенерированной 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 и должна выглядеть как = средняя($ c6: $ E6), а затем скопировать его в диапазон b $ 8: $ b $ 53 с корректировкой, чтобы отразить изменение в строке.

Ответы [ 2 ]

0 голосов
/ 20 июня 2019

Не уверен, что я что-то здесь упускаю, но вам не нужно зацикливаться. Вы можете сделать формулу за один раз, затем скопировать и вставить значения:

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

Нет выбора и циклов.

0 голосов
/ 20 июня 2019

Исправлена ​​моя проблема.

Возможно, не лучшее решение, но оно работает.После внесения поправок в формулу, чтобы удалить функцию блокировки ячеек.Затем использовали другой метод для копирования в ячейки в диапазоне ремонтника.

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

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...