Giải pháp của Lance sẽ hoạt động trong phần lớn các trường hợp.
Nhưng nếu bạn xử lý các bảng tính lớn/phức tạp, bạn có thể chạy vào "SpecialCells Problem". Tóm lại, nếu phạm vi tạo ra lớn hơn 8192 vùng không tiếp giáp (và có thể xảy ra xảy ra) thì Excel sẽ phát ra lỗi khi bạn cố gắng truy cập vào SpecialCells và mã của bạn sẽ không chạy. Nếu bảng tính của bạn đủ phức tạp, bạn sẽ gặp phải vấn đề này, thì bạn nên gắn bó với phương pháp lặp.
Cần lưu ý rằng vấn đề này không phải là với thuộc tính SpecialCells, mà là với đối tượng Phạm vi. Điều này có nghĩa là bất cứ khi nào bạn cố gắng lấy một đối tượng phạm vi có thể rất phức tạp, bạn phải xử lý lỗi hoặc làm như bạn đã làm, điều này làm cho chương trình của bạn hoạt động trên mỗi phần tử của phạm vi (chia xếp hàng).
Một cách tiếp cận khác có thể là trả về một mảng các đối tượng vùng và sau đó lặp qua mảng. Tôi đã đăng một số mã ví dụ để chơi xung quanh. Tuy nhiên cần lưu ý rằng bạn thực sự chỉ nên bận tâm với điều này nếu bạn mong đợi để có vấn đề mô tả hoặc bạn chỉ muốn cảm thấy yên tâm mã của bạn là mạnh mẽ. Nếu không thì nó chỉ là sự phức tạp không cần thiết.
Option Explicit
Public Declare Function GetTickCount Lib "kernel32"() As Long
Public Sub GenerateProblem()
'Run this to set up an example spreadsheet:
Dim row As Long
Excel.Application.EnableEvents = False
Sheet1.AutoFilterMode = False
Sheet1.UsedRange.Delete
For row = 1 To (8192& * 4&) + 1&
If row Mod 3& Then If Int(10& * Rnd) 7& Then Sheet1.Cells(row, 1&).value = "test"
Next
Sheet1.UsedRange.AutoFilter 1&, ""
Excel.Application.EnableEvents = True
MsgBox Sheet1.UsedRange.SpecialCells(xlCellTypeVisible).address
End Sub
Public Sub FixProblem()
'Run this to see various solutions:
Dim ranges() As Excel.Range
Dim index As Long
Dim address As String
Dim startTime As Long
Dim endTime As Long
'Get range array.
ranges = GetVisibleRows
'Do something with individual range objects.
For index = LBound(ranges) To UBound(ranges)
ranges(index).Interior.ColorIndex = Int(56 * Rnd + 1)
Next
'Get total address if you want it:
startTime = GetTickCount
address = RangeArrayAddress(ranges)
endTime = GetTickCount
Debug.Print endTime - startTime, ; 'Outputs time elapsed in milliseconds.
'Small demo of why I used a string builder. Straight concatenation is about
'10 times slower:
startTime = GetTickCount
address = RangeArrayAddress2(ranges)
endTime = GetTickCount
Debug.Print endTime - startTime
End Sub
Public Function GetVisibleRows(Optional ByVal ws As Excel.Worksheet) As Excel.Range()
Const increment As Long = 1000&
Dim max As Long
Dim row As Long
Dim returnVal() As Excel.Range
Dim startRow As Long
Dim index As Long
If ws Is Nothing Then Set ws = Excel.ActiveSheet
max = increment
ReDim returnVal(max) As Excel.Range
For row = ws.UsedRange.row To ws.UsedRange.Rows.Count
If Sheet1.Rows(row).Hidden Then
If startRow 0& Then
Set returnVal(index) = ws.Rows(startRow & ":" & (row - 1&))
index = index + 1&
If index > max Then
'Redimming in large increments is an optimization trick.
max = max + increment
ReDim Preserve returnVal(max) As Excel.Range
End If
startRow = 0&
End If
ElseIf startRow = 0& Then startRow = row
End If
Next
ReDim Preserve returnVal(index - 1&) As Excel.Range
GetVisibleRows = returnVal
End Function
Public Function RangeArrayAddress(ByRef value() As Excel.Range, Optional lowerindexRV As Variant, Optional upperindexRV As Variant) As String
'Parameters left as variants to allow for "IsMissing" values.
'Code uses bytearray string building methods to run faster.
Const incrementChars As Long = 1000&
Const unicodeWidth As Long = 2&
Const comma As Long = 44&
Dim increment As Long
Dim max As Long
Dim index As Long
Dim returnVal() As Byte
Dim address() As Byte
Dim indexRV As Long
Dim char As Long
increment = incrementChars * unicodeWidth 'Double for unicode.
max = increment - 1& 'Offset for array.
ReDim returnVal(max) As Byte
If IsMissing(lowerindexRV) Then lowerindexRV = LBound(value)
If IsMissing(upperindexRV) Then upperindexRV = UBound(value)
For index = lowerindexRV To upperindexRV
address = value(index).address
For char = 0& To UBound(address) Step unicodeWidth
returnVal(indexRV) = address(char)
indexRV = indexRV + unicodeWidth
If indexRV > max Then
max = max + increment
ReDim Preserve returnVal(max) As Byte
End If
Next
returnVal(indexRV) = comma
indexRV = indexRV + unicodeWidth
If indexRV > max Then
max = max + increment
ReDim Preserve returnVal(max) As Byte
End If
Next
ReDim Preserve returnVal(indexRV - 1&) As Byte
RangeArrayAddress = returnVal
End Function
Public Function RangeArrayAddress2(ByRef value() As Excel.Range, Optional lowerIndex As Variant, Optional upperIndex As Variant) As String
'Parameters left as variants to allow for "IsMissing" values.
'Code uses bytearray string building methods to run faster.
Const incrementChars As Long = 1000&
Const unicodeWidth As Long = 2&
Dim increment As Long
Dim max As Long
Dim returnVal As String
Dim index As Long
increment = incrementChars * unicodeWidth 'Double for unicode.
max = increment - 1& 'Offset for array.
If IsMissing(lowerIndex) Then lowerIndex = LBound(value)
If IsMissing(upperIndex) Then upperIndex = UBound(value)
For index = lowerIndex To upperIndex
returnVal = returnVal & (value(index).address & ",")
Next
RangeArrayAddress2 = returnVal
End Function
cảm ơn bạn. nó hoạt động trong Excel 2007. Sẽ kiểm tra trong Excel 2003 tommorow –