Excel 数字排序范围地址

我的代码片段是用来查看工作簿中的所有工作表，找到特定文本位置的地址，并将该区域复制回摘要页面

注意：以下代码确实适用于我的目的。

摘要页面算法当前正在将值粘贴为：

2,3,1

而不是想要的

1,2,3

当前我的FoundRange.Address=

从手表窗口粘贴

“Watch:：FoundRange.Address:$B$60、$B$110、$B$34”：字符串：Module1.summary\u POL\u Sheets

注意：

FoundRange

是我在此VBA代码中创建的变量范围

为了获得所需的粘贴顺序，我希望将地址顺序更改为“$B$34、$B$60、$B$110”

你们都建议什么是补救这一问题的最佳措施？ 有没有办法按数值对该范围地址进行排序

代码片段如下所示：

    'Activate current sheet in the sheet loop
    sh.Activate
    
    'Returns a Range object that represents the used range on the specified worksheet
    Set FindRange = ActiveSheet.UsedRange
    'finds the last used cell within the active sheet
    Set LastCell = FindRange.Cells(FindRange.Cells.Count)
    'find specified value within our specified cell
    '   Set Find "after" operand to "LastCell",i.e. the last cell used in the active sheet.
    '   The search will “wrap around”; this means it will go back to the start of the range.
    Set FoundCell = FindRange.Find(what:=ReqBlockString, after:=LastCell)
    
    'Test to see if anything was found
      'If FoundCell is something Then
      If Not FoundCell Is Nothing Then
        FirstFound = FoundCell.Address
      Else
        GoTo ReqBlockNotFound
      End If
    
    Set FoundRange = FoundCell
    
      'Loop until cycled through all unique finds
      'Do Loop (1)
      Do Until FoundCell Is Nothing
        'Find next cell with Text2Find value
         Set FoundCell = FindRange.FindNext(after:=FoundCell)
        
        'Add found cell to FoundRange range variable
         Set FoundRange = Union(FoundRange, FoundCell)
        
        'Test to see if cycled through to first found cell
         If FoundCell.Address = FirstFound Then Exit Do
          
      Loop
      'End Of Do Loop (1)
      
      '*************Add Sorting Here*******************


     'Copy test for FoundRange
     For Each PasteRange In FoundRange
     
    'FoundRange.Copy
    sh.Range(PasteRange.Address).CurrentRegion.Copy
     
    'Activate the Summary Sheet
    Sheets("Summary").Activate
     
    'Sets copy range to the next available empty row
    Set nextEmptyCell = Range("A" & Rows.Count).End(xlUp).Offset(1)
    nextEmptyCell.PasteSpecial (xlPasteColumnWidths)
    nextEmptyCell.PasteSpecial (xlPasteAll)
    
    Next PasteRange

更新（更正订单）

将Union语句移到Exit条件和Loop语句之间 更新代码如下所示：

'Loop until cycled through all unique finds
      'Do Loop (1)
      Do Until FoundCell Is Nothing
        'Find next cell with Text2Find value
         Set FoundCell = FindRange.FindNext(after:=FoundCell)
        
        
        'Test to see if cycled through to first found cell
         If FoundCell.Address = FirstFound Then Exit Do
         
         'Add found cell to FoundRange range variable
         'Moving the Union statement here prevents the First cell from going 
         'through the union statement twice, this was the original culprit
         'for the improper ordering
         Set FoundRange = Union(FoundRange, FoundCell)
        

      Loop
      'End Of Do Loop (1)

---

Find（）（FoundCell，FoundRange）

。谢谢大家！我能够通过在退出条件和循环语句之间移动Union语句来获得我想要的顺序

Find（）

应该从搜索范围的开始到结束运行，因此如果在查找循环中移动复制/粘贴，那么应该可以工作-您不需要在此处使用联合范围。顺序在此处确定：

Set-FoundRange=union（FoundRange，FoundCell）

。要反转它，请反转：

Set-FoundRange=union（FoundCell，FoundRange）

。谢谢大家！我可以通过在退出条件和循环语句之间移动Union语句来获得所需的顺序