带有循环和联合的 MS VBA

Question

Dim Counter As Integer
Dim Maxhouse As Integer
Dim FindHouse As Range
Dim RangeVar As Range
Dim HousesRange As Range

    For Counter = 1 To MaxHouse
        ActiveSheet.Cells(16, 2 + Counter).Select
        House = ActiveCell
        With Sheets("Sheet1").Range("C:KP")
            Set FindHouse = Cells.Find(What:=House, _
                After:=Cells(17, 1), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
            If Not FindHouse Is Nothing Then
                If Counter = 1 Then
                    Set HousesRange = FindHouse
                Else
                    Set RangeVar = FindHouse
                    Set HousesRange = Union(HousesRange, RangeVar)
                End If
            End If
        End With
    Next Counter

    For Each RCell In HousesRange.Cells
        Application.Goto RCell, True
    Next RCell**

现在我的问题是遍历命名范围“HousesRange”的for循环

假设 HousesRange 包含 [2,5,9,10]。

这里的 HousesRange 是我的工作表中 [1,2,3,4,5,6,7,8,9,10] 行的子集

假设 HousesRange 是通过 [9,10,5,2] 的顺序建立的（通过第一个 for 循环与并集）。

现在，当我仅使用 rCells（第二个 for 循环）遍历 HousesRange 时，它​​会将我带到 9、10、5，然后是 2。

但我希望它带我去 2、5、9 和 10

有人可以对此有所了解吗？

我一直认为命名范围总是从左到右然后从上到下遍历。

非常感谢您

Answer 1

好的，这是很长的路要走，但它应该可以工作：

而不是使用Union 在字典对象中构建找到的房屋列表。 然后使用Bubblesort HouseRangeDic 对范围进行排序 您终于应该能够以正确的顺序使用它了：

Dim Counter As Integer
Dim Maxhouse As Integer
Dim FindHouse As Range
Dim RangeVar As Range
Dim HousesRange As Range

'****** NEW **********
Dim foundHouseCount
foundHouseCount = 1
Dim HouseRangeDic
Set HouseRangeDic = CreateObject("Scripting.dictionary")
'*********************

    For Counter = 1 To Maxhouse
        ActiveSheet.Cells(16, 2 + Counter).Select
        House = ActiveCell
        With Sheets("Sheet1").Range("C:KP")
            Set FindHouse = Cells.Find(What:=House, _
                After:=Cells(17, 1), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
            If Not FindHouse Is Nothing Then
                HouseRangeDic.Add foundHouseCount, RangeVar '**** NEW ***
                foundHouseCount = foundHouseCount + 1 '**** NEW ***
            End If
        End With
    Next Counter

    '**** NEW ***
    Bubblesort HouseRangeDic

    For i = 1 To HouseRangeDic.Count
       Application.Goto HouseRangeDic(i), True
    Next
    '************


Sub Bubblesort(ByRef rangeDic)
    Dim tempRange
    For i = 1 To rangeDic.Count - 1
        For j = i To rangeDic.Count
            If rangeDic(i).Address > rangeDic(j).Address Then
                Set tempRange = rangeDic(i)
                Set rangeDic(i) = rangeDic(j)
                Set rangeDic(j) = tempRange
            End If
        Next
    Next
End Sub

Answer 2

看看这是否适合你。请注意，我的“After:=" 设置为范围的最后一个单元格，因此第一个查找从范围的开头开始。

Sub loopCells()
    Dim FindHouse As Range
    Dim HousesRange As Range
    Dim rcell As Range
    Dim r As Range
    Dim sAdd As String
    Dim House As Long

    Set r = Sheets("Sheet1").Range("$C$15:$K$20") 'change to suit

    House = 11'change to suit
    With r

        Set FindHouse = .Find(What:=House, After:=r(.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, _
            SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        If Not FindHouse Is Nothing Then
            sAdd = FindHouse.Address
            Do
               If HousesRange Is Nothing Then
                    Set HousesRange = FindHouse
                Else
                    Set HousesRange = Union(HousesRange, FindHouse)
                End If
                Set FindHouse = .FindNext(FindHouse)
            Loop While Not FindHouse Is Nothing And FindHouse.Address <> sAdd
        End If
    End With

    For Each rcell In HousesRange
        Application.Goto rcell
    Next rcell

End Sub