Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
422 views
in Technique[技术] by (71.8m points)

excel - Sorting Range Addresses Numerically

My code snippet is meant to look through all sheets in workbook and find the address of that specific text's location and copy the region back to a summary page.

Note: Code below does indeed work for my purposes.

The summary page algorithm is currently pasting the values as:

2,3,1

instead of the desired

1,2,3

Currently my FoundRange.Address =

Pasted from Watch Window

"Watch : : FoundRange.Address : "$B$60,$B$110,$B$34" : String : Module1.Summarize_POL_Sheets

Note: FoundRange is a variable range that I created within this VBA code

In order for the get the desired paste order the addresses I would like to be change the address order to "$B$34,$B$60,$B$110"

What would you all recommend would be the best coarse of action to remedy this? Is there a way to sort this range address by numerical value?

Code snippet shown below:

    '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

UPDATE (Corrected Order)

Moved the Union statement in-between the Exit condition and the Loop statement Updated Code shown here:

'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)

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)
等待大神答复

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...