build立备用单元格范围vba

我的意图是build立一个dynamic的替代细胞范围失败，显然是缺乏知识。

For j = 1 To numFrame Set MaxStRange_OD_OUT = ActiveSheet.Range(Cells(1, 2 * (j + 1))) MaxVal = Application.Max(MaxStRange_OD_OUT) Debug.Print MaxVal Next j 

我想要的是

 MaxStRange_OD_OUT = ActiveSheet.Range(Cells(1, 4),Cells(1, 6),Cells(1, 8)) 

当然细胞的数量可以改变，比如从1到10（numFrame）

谢谢

Answer 1

你可以使用Application.Union来build立一个范围。

 Sub UnionRangeExample() Dim rng As Range Dim i As Long For i = 1 To 20 Step 2 If rng Is Nothing Then Set rng = ActiveSheet.Cells(i, 1) Else Set rng = Application.Union(rng, ActiveSheet.Cells(i, 1)) End If Next i MsgBox rng.Address End Sub 

---

在你的情况下，你可以像这样使用它：

 Sub UnionRangeExample_v2() Dim rng As Range Dim j As Long Dim numFrame As Long numFrame = 10 For j = 1 To numFrame If rng Is Nothing Then Set rng = ActiveSheet.Cells(1, 2 * (j + 1)) Else Set rng = Application.Union(rng, ActiveSheet.Cells(1, 2 * (j + 1))) End If Next j MsgBox "max for: " & rng.Address & " is " & Application.Max(rng) End Sub 

Answer 2

你可以在这里试试这个代码

 Function MyMaxValue() as Double Dim maxValue As Double, numFrame As Double, i As Integer, currentValue As Double numFrame = 7 For i = 1 To numFrame currentValue = Cells(1, 2 * (j + 1)).value If currentValue > maxValue Then maxValue = currentValue Debug.Print "new value = " & maxValue End If Next i MyMaxValue = maxValue End Function