如何在代码中创建一个范围，并使用这些名称范围来查找平均值，然后将该值显示到某个单元格中

Question

如何在代码中创建一个范围，并使用这些名称范围来找到平均值，然后将该值显示到某个单元格中

我正在尽我最大的努力！！

我的代码：

Sub NameRanges()
Dim HourlyConsumption As Range
Set HourlyConsumption = Range("B2:B251")
ThisWorkbook.Names.Add name:="HourlyConsumption", RefersTo:=HourlyConsumption
Dim Replenishment As Range
Set Replenishment = Range("C2:C251")
ThisWorkbook.Names.Add name:="Replenishment", RefersTo:=Replenishment
End Sub

Sub DataAverages()
Dim AVGHourlyConsumption As Double
Dim AVGReplenishment
AVGHourlyConsumption = (Range("HourlyConsumption").Value) / ("HourlyConsumption")
AVGReplenishment = (Range("Replenishment").Value) / ("Replenishment")
Set AVGHourlyConsumption.Value = Cells("H1")
Set AVGReplenishment.Vaule = Cells("H2")
End Sub

Answer 1

添加命名范围

Option Explicit
Sub DoTheJob() ' rename appropriately!
NameRanges
PopulateAverages
End Sub
Sub NameRanges()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1") ' adjust!
' Use the 'AddNamedRange' method to safely add the named ranges:
AddNamedRange "HourlyConsumption", "B2:B251", sws
AddNamedRange "Replenishment", "C2:C251", sws
End Sub
Sub PopulateAverages()

Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Note that this worksheet can be different
' than the worksheet containing the named ranges.
Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet1") ' adjust!
' Formulas
With dws.Range("H1")
.Formula = "=IFERROR(AVERAGE(HourlyConsumption),"""")"
'.NumberFormat = "0.0000"
'.Font.Bold = True
'.Interior.Color = vbYellow
End With
With dws.Range("H2")
.Formula = "=IFERROR(AVERAGE(Replenishment),"""")"
'.NumberFormat = "0.0000"
'.Font.Bold = True
'.Interior.Color = vbYellow
End With

' Values
'    With dws.Range("H1")
'        .Value = dws.Evaluate("IFERROR(AVERAGE(HourlyConsumption),"""")")
'    End With
'    With dws.Range("H2")
'        .Value = dws.Evaluate("IFERROR(AVERAGE(Replenishment),"""")")
'    End With

End Sub
Sub AddNamedRange( _
ByVal RangeName As String, _
ByVal RangeAddress As String, _
ByVal WorksheetObject As Worksheet, _
Optional ByVal ApplyWorksheetScope As Boolean = False)
With WorksheetObject
On Error Resume Next
.Parent.Names(RangeName).Delete
On Error GoTo 0
If ApplyWorksheetScope Then
.Names.Add RangeName, .Range(RangeAddress)
Else
.Parent.Names.Add RangeName, .Range(RangeAddress)
End If
End With
End Sub