简体   繁体   中英

VBA Function to test and change user range input's row number and sheet index no

I'm trying to perform quite a simple task with a custom function in VBA.

I have a macro which iterates through large Excel data files which are split into sheets of 50,000 rows.

Unfortunately I can't stitch these all together and loop down the columns because this often exceeds the 1,048,576 row limit for each sheet in excel.

My macro will loop down through the data until a condition is met, and record its row number for future reference. Obviously when it reaches any row >50,000 then it needs to move onto the next sheet and carry on the iteration process.

However I'm having trouble dealing with values either side of the 50,000 limit eg: sheets(3).Cells(50021,2) .

What I need is something like this:

Input:

customfunction(sheets(3).Cells(50021,2))

Output:

sheets(4).Cells(21,2)
Public Type SheetPositions
  SheetIndex As Long
  RowNumber As Long
End Type

Public Function TranslateRange(ByVal c As Range) As Range
  With TranslatePositions(c.Worksheet.Index, c.Row)
    Set TranslateRange = c.Worksheet.Parent.Worksheets(.SheetIndex).Cells(.RowNumber, c.Column)
  End With
End Function

Public Function TranslatePositions(ByVal SheetIndex As Long, ByVal RowNumber As Long) As SheetPositions
  Const ROWS_PER_SHEET As Long = 50000

  If RowNumber <= ROWS_PER_SHEET Then
    TranslatePositions.SheetIndex = SheetIndex
    TranslatePositions.RowNumber = RowNumber
  Else
    TranslatePositions.SheetIndex = SheetIndex + RowNumber \ ROWS_PER_SHEET
    TranslatePositions.RowNumber = RowNumber Mod ROWS_PER_SHEET
  End If
End Function
Dim r As Range
Set r = Worksheets(2).Cells(50021, 1)
Set r = TranslateRange(r)
With TranslatePositions(3, 50021)
  MsgBox "Sheet " & .SheetIndex & " row " & .RowNumber
End With

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM