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

某些机构可以对此有所了解吗?

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

非常感谢你提前

最佳答案

好的,这是很长的路要走,但它应该工作:

不要使用 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

关于excel - 带有循环和联合的 MS VBA,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/20415835/

10-10 18:45