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/