Xác định số dòng Visible trong 1 vùng cho trước

Liên hệ QC

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia
5/6/08
Bài viết
30,703
Được thích
53,952
Nhờ các cao thủ chỉ giúp 1 đoạn code để xác định chính xác số dòng Visible trong 1 vùng chọn trước
Ví dụ: Ta có trước dòng 2 và 6 đang ẩn
- Nếu vùng chọn là A1:E10 thì kết quả cần đạt được là =10 dòng - 2 dòng ẩn = 8
- Nếu vùng chọn là A5:D7 thì kết quả cần đạt được là = 3 dòng - 1 dòng ẩn = 2
vân... vân....
 
Các ACE đã giải quyết rồi, tôi chỉ gửi 1 hàm góp vui thôi :-)

PHP:
Function countVi(ParamArray ra()) As Long
Dim sh As Worksheet
Dim i As Long, mi As Long, ma As Long
Dim h As Long, m1 As Long, m2 As Long
Dim a1()
    Application.Volatile
    Set sh = ActiveSheet
    mi = 65000
    ma = 0
    For i = LBound(ra) To UBound(ra)
        If TypeName(ra(i)) = "Range" Then
            m1 = ra(i).Row
            m2 = m1 + ra(i).Rows.Count - 1
            If mi > m1 Then mi = m1
            If ma < m2 Then ma = m2
            ReDim Preserve a1(1 To ma)
            For h = m1 To m2
                If Not sh.Cells(h, 1).EntireRow.Hidden Then a1(h) = h
            Next
        Else
            countVi = 0
            Set sh = Nothing
            Exit Function
        End If
    Next
    m1 = 0
    For i = mi To ma
        If a1(i) > 0 Then m1 = m1 + 1
    Next
    Set sh = Nothing
    countVi = m1
End Function


>>> Nhờ Po_Pikachu kiểm tra code sau khi đã hiệu chỉnh nhé ! Thx!

-hvl-
 
Lần chỉnh sửa cuối:
Upvote 0
Code của bạn chạy đúng vùng chồng lắp nhưng khi quét =countVi(A1:A3,B5:B7) Với dòng 2 ẩn thì nó ra kết quả là 6 chứ không phải 5. Vẩn còn phải làm nữa bạn ơi! Chúc thành công! Thân.
 
Lần chỉnh sửa cuối:
Upvote 0
Count if Visible

Code của bạn chạy đúng vùng chồng lắp nhưng khi quét
=countVi(A1:A3,B5:B7)
Với dòng 2 ẩn thì nó ra kết quả là 6 chứ không phải 5. Vẩn còn phải làm nữa bạn ơi!
Chúc thành công!
Thân.

Đã hiệu chỉnh code, nhờ bạn kiểm tra lại nhé! Thx!

-hvl-
 
Upvote 0
Đã hiệu chỉnh code, nhờ bạn kiểm tra lại nhé! Thx!

-hvl-
Cãm ơn bạn đã tham gia trợ giúp cho tôi!
Nhưng trong mấy vụ ẩn dòng ẩn cột này tôi ít khi thích dùng Function.. Lý do là mổi khi muốn kiểm tra dòng nào ẩn, hiện lại phải dùng For để quét... Trong khi nếu dùng Sub thì ta có cái thuận lợi hơn trong việc dùng phương thức SpecialCells, tiếc kiệm được thời gian (mà trong Function lại không cho phép dùng phương thức này)
Nói thật code tôi làm xong cũng chưa hài lòng lắm (dài quá)... Vậy mong bạn giúp tôi, nếu có đoạn code nào tốt hơn thì post lên cho tôi học hỏi với (tất nhiên là tôi vẩn ưu tiên việc dùng Sub hơn là Function)
Cãm ơn bạn trước!
 
Upvote 0
Thử cái này xem!
PHP:
Sub Test_Hidden()  Dim Rng As Range
  Set Rng = Application.InputBox(Prompt:="Chon vung", Type:=8)
  On Error GoTo Err
  If Rng.Rows.Count = 1 Then
      MsgBox Rng.Resize(, 2).SpecialCells(xlCellTypeVisible).Count / 2
  Else
      MsgBox Rng.Resize(, 1).SpecialCells(xlCellTypeVisible).Count
  End If
  Exit Sub
  Err:
  MsgBox Error
  End Sub
Đúng ra thì chỉ cần 1 lệnh chính "Rng.Resize(, 1).SpecialCells(xlCellTypeVisible).Count"
Nhưng nó không đúng khi chọn duy nhất 1 dòng (số chỉ ra = tổng số cells không ẩn, số này lên đến hàng triệu!) cho nên phải xét thêm trường hợp chỉ chọn 1 dòng.
Ngoài ra, khi vùng chọn đều bị ẩn thì sẽ báo error "No cells were found." - Tận dụng luôn câu thông báo này. Nếu không thích thì có thể đổi câu thông báo theo ý riêng.
 
Upvote 0
Thử cái này xem!
PHP:
Sub Test_Hidden()  Dim Rng As Range
  Set Rng = Application.InputBox(Prompt:="Chon vung", Type:=8)
  On Error GoTo Err
  If Rng.Rows.Count = 1 Then
      MsgBox Rng.Resize(, 2).SpecialCells(xlCellTypeVisible).Count / 2
  Else
      MsgBox Rng.Resize(, 1).SpecialCells(xlCellTypeVisible).Count
  End If
  Exit Sub
  Err:
  MsgBox Error
  End Sub
Đúng ra thì chỉ cần 1 lệnh chính "Rng.Resize(, 1).SpecialCells(xlCellTypeVisible).Count"
Nhưng nó không đúng khi chọn duy nhất 1 dòng (số chỉ ra = tổng số cells không ẩn, số này lên đến hàng triệu!) cho nên phải xét thêm trường hợp chỉ chọn 1 dòng.

Ngoài ra, khi vùng chọn đều bị ẩn thì sẽ báo error "No cells were found." - Tận dụng luôn câu thông báo này. Nếu không thích thì có thể đổi câu thông báo theo ý riêng.
Nếu là vậy sao bạn không Resize(,2) hết toàn bộ rồi cuối cùng chia cho 2
Trường hợp vùng chọn là 1 cell thì Resize xong nó sẽ thành 2 cell (đâu cần IF).. kiểu vầy đây:
PHP:
Sub Test_Hidden()
  Dim Rng As Range
  Set Rng = Application.InputBox(Prompt:="Chon vung", Type:=8)
  On Error Resume Next
  k = Rng.Resize(, 2).SpecialCells(xlCellTypeVisible).Count / 2
  MsgBox k
End Sub
Nhưng dù sao code này vẩn thiếu... vì nếu vùng chọn là nhiều range không liền kề sẽ ra kết quả sai
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom