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

[ndu96081631]

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à A57 thì kết quả cần đạt được là = 3 dòng - 1 dòng ẩn = 2
vân... vân....

 

[Po_Pikachu]

Tạm thời xài cách này trước. Khi nào nghỉ ra cách hay hơn em sẽ báo nha! (DK: ko ai dành trước! Hee..he..)

Function demvisible(vung As Range) For i = 1 To vung.Rows.Count If vung.Cells(i, 1).EntireRow.Hidden = False Then k = k + 1 End If Next demvisible = k End Function

Thân.

 

[hoangvuluan]

Nếu cột đầu tiên của vùng đã chọn có chứa đầy đủ dữ liệu thì có thể dùng cách đơn giản hơn:

Rows(vùng) - Subtotal(103, vùng)

-hvl-

 

[Po_Pikachu]

Có vẻ chưa đúng lắm nếu vùng đó không có dữ liệu. Bạn nghiên cứu thêm nha. Chúc thành công! Thân.

 

[ndu96081631]

Tạm thời xài cách này trước. Khi nào nghỉ ra cách hay hơn em sẽ báo nha! (DK: ko ai dành trước! Hee..he..)

Function demvisible(vung As Range)
For i = 1 To vung.Rows.Count
If vung.Cells(i, 1).EntireRow.Hidden = False Then
k = k + 1
End If
Next
demvisible = k
End Function

Thân.

Quét qua từng cell là giãi pháp cuối cùng rồi... đương nhiên kết quả rất chính xác
Nhưng ở đây tôi muốn:
1> Tạo code thành 1 Sub (chứ không phải Function) ---> Vì trong Sub ta còn có thể dùng SpecicalCells
2> Một cái gì đó độc đáo hơn For... Next
3> Đếm Rows Visible thì không liên quan gì đến dử liệu nên tất nhiên không thể dùng SUBTOTAL rồi
4> Sub phải cho kết quả chính xác ngay cả khi tôi chọn nhiều vùng không liên tục
Mới nghĩ qua thấy khá đơn giãn, nhưng loay hoay hoài vẩn chưa ra! (vướng khá nhiều chổ)

Tôi xin nói thêm quá trình làm code!
Nếu vùng chọn là 1 vùng liên tục thì tôi tạm dùng code này:

Sub Test1()
 Dim Rng As Range
 Set Rng = Application.InputBox(Prompt:="Chon Vung", Type:=8)
 MsgBox Rng.Resize(, 1).SpecialCells(12).Cells.Count, , "Total"
End Sub

Thấy cũng gọn nhưng đáng tiếc nó vẩn chưa cho kết quả chính xác (khi chọn 1 cell duy nhất)
Các bạn nghiên cứu giúp với (tôi đang cần nó trong 1 bài toán lớn hơn)

 

[Po_Pikachu]

Vậy bác thêm lệnh IF xử lý việc có 1 ô thôi?! Thân.

 

[ndu96081631]

Vậy bác thêm lệnh IF xử lý việc có 1 ô thôi?!
Thân.

Xin bạn gữi code lên xem thử (đang bị rối đầu)
Cãm ơn trước nha!

 

[ThuNghi]

Xin bạn gữi code lên xem thử (đang bị rối đầu)
Cãm ơn trước nha!

Xin hỏi làm gì vậy?

Sub Test1()
Dim Rng As Range
Set Rng = Application.InputBox(Prompt:="Chon Vung", Type:=8)
If Rng.Rows.Count = 1 Then
    MsgBox 1
Else
    MsgBox Rng.SpecialCells(12).Cells.Count
End If
 
End Sub

 

[rollover79]

Xin hỏi làm gì vậy?

Sub Test1()
Dim Rng As Range
Set Rng = Application.InputBox(Prompt:="Chon Vung", Type:=8)
If Rng.Rows.Count = 1 Then
    MsgBox 1
Else
    MsgBox Rng.SpecialCells(12).Cells.Count
End If
 
End Sub

Nếu 1 cell đó lại đúng là cell ẩn thì sao bác? Ý em là người dùng ko quét vùng mà lại nhập địa chỉ trực tiếp vào cái InputBox, và họ nhập vào địa chỉ 1 cell nằm trong Row ẩn. Túm lại là vẫn phải kiểm tra xem nó là ẩn hay không ẩn.

From ThuNghi:
Làm sao mà chọn vào cell ẩn được, nếu row 2 ẩn thì chọn cells(1,x) thì =1. hay chọn cella(3,x) =1.
Chưa hiểu lắm.

Em nói rõ ở bài trước rồi mà, quét chọn thì không thể chọn đc 1 cell ẩn, nhưng sao cấm họ nhập vào địa chỉ của 1 cell bất kỳ vào cái InputBox đó được ạ?

 

[Po_Pikachu]

Vì em sợ đưa ra thì hơi kỳ. Chỉ là hàm IF thôi mà! Rồi bác ThuNghi cũng đã đưa rồi nên em chỉ xin dùng code của bác ThuNghi bổ sung thêm ý của em thôi. Mong mọi người đừng cười.

[FONT=Courier New][COLOR=#0000bb]Sub Test1[/COLOR][/FONT][FONT=Courier New][COLOR=#007700]() [/COLOR][COLOR=#0000bb]Dim Rng [/COLOR][COLOR=#007700]As [/COLOR][/FONT][FONT=Courier New][COLOR=#0000bb]Range Set Rng [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]Application[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]InputBox[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]Prompt[/COLOR][COLOR=#007700]:=[/COLOR][COLOR=#dd0000]"Chon Vung"[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000bb]Type[/COLOR][COLOR=#007700]:=[/COLOR][COLOR=#0000bb]8[/COLOR][/FONT][FONT=Courier New][COLOR=#007700]) If [/COLOR][COLOR=#0000bb]Rng[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Rows[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Count [/COLOR][COLOR=#007700]= [/COLOR][/FONT][COLOR=#0000bb][FONT=Courier New]1 And Rng[COLOR=#007700].[/COLOR][COLOR=#0000bb]EntireRow[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Hidden [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]False [/COLOR]Then [COLOR=#ffffff]___[/COLOR]MsgBox 1 [/FONT][/COLOR][FONT=Courier New][COLOR=#007700]ElseIF [COLOR=#0000bb]Rng[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Rows[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Count [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb][FONT=Courier New]1 And [/FONT][/COLOR]Rng[/COLOR][/FONT][COLOR=#000000][FONT=Courier New][COLOR=#007700][COLOR=#007700].[/COLOR][COLOR=#0000bb]EntireRow[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Hidden [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]True Then[/COLOR] [COLOR=#0000bb][COLOR=#ffffff]___[/COLOR]MsgBox "Khong thoa dieu kien"[/COLOR][/COLOR][/FONT][/COLOR] [COLOR=#000000][COLOR=#0000bb][FONT=Courier New]Else[/FONT][/COLOR][/COLOR] [COLOR=#000000][COLOR=#0000bb][FONT=Courier New][COLOR=#0000bb][COLOR=white]___[/COLOR]MsgBox Rng[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]SpecialCells[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]12[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Cells[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb][FONT=Courier New]Count[/FONT][/COLOR] End [/FONT][/COLOR][FONT=Courier New][COLOR=#007700]If [/COLOR][COLOR=#0000bb]End Sub[/COLOR][/FONT][/COLOR]

Mỗi khi nghỉ hoài ko ra (nóng cả đầu ) thì nên ra ngoài trời la thật lớn lên. Rồi ngồi xuống dưới góc cây, khoảng 15-20 phút. Nghe gió thổi (nếu có), hoặc nghe nhạc nhẹ trên ghế xôpha cũng được. Bảo đảm sao khi nghỉ xong. Một là tìm ra hai là nghỉ luôn khỏi làm. Như vậy chắc chắn khỏi nhức đầu! Hee..hee.. Thân.

 

[Lệnh Hồ Đại Hiệp]

Vì em sợ đưa ra thì hơi kỳ. Chỉ là hàm IF thôi mà!
Rồi bác ThuNghi cũng đã đưa rồi nên em chỉ xin dùng code của bác ThuNghi bổ sung thêm ý của em thôi. Mong mọi người đừng cười.

[FONT=Courier New][COLOR=#0000bb]Sub Test1[/COLOR][/FONT][FONT=Courier New][COLOR=#007700]()
[/COLOR][/FONT]
[COLOR=#000000][COLOR=#0000bb][FONT=Courier New][COLOR=#0000bb][COLOR=white]___[/COLOR]MsgBox Rng[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]SpecialCells[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]12[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000bb]Cells[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb][FONT=Courier New]Count[/FONT][/COLOR]
[/FONT][/COLOR][FONT=Courier New][COLOR=#007700]
[/COLOR][COLOR=#0000bb]End Sub[/COLOR][/FONT][/COLOR]

Cái này là đếm số Cells chứ đâu phải đếm số dòng đâu bạn ???

Chúc vui.

 

[Po_Pikachu]

À, mượn là vậy đó. Bác test lại xem có được chưa!

Sub Test1() Dim Rng As Range Set Rng = Application.InputBox(Prompt:="Chon Vung", Type:=8) If Rng.Rows.Count = 1 And Rng.EntireRow.Hidden = False Then     MsgBox 1 ElseIf Rng.Rows.Count = 1 And Rng.EntireRow.Hidden = True Then     MsgBox "Khong thoa dieu kien" Else     MsgBox Int(Rng.SpecialCells(12).Cells.Count / Rng.Columns.Count) End If End Sub

Thân

 

[ChanhTQ@]

Vẫn chửa!

Bác test lại xem có được chưa! Thân

Nếu làm cách nào đó chọn 2 vùng không kề nhau & cùng chứa các dòng ẩn thì macro của bạn sẽ khai khống!
Còn 'cách nào đó' thì quá dễ, phải không bạn!

 

[ndu96081631]

Tạm thời tôi làm vầy (dù vẩn chưa hài lòng lắm)... Bằng cách Resize toàn bộ các vùng thành 2 cột (mục đích tránh trường hợp chọn 1 cell)... Chuyển nó đến cột A rồi dùng Union đễ hợp chúng lại

Sub RowsVisible()
 Dim Rng As Range, TempRng As Range, i As Long, k As Long
 On Error Resume Next
 Set Rng = Application.InputBox(Prompt:="Chon Vung", Type:=8)
 Set TempRng = Cells(Rng.Areas(1).Row, 2)
 For i = 1 To Rng.Areas.Count
   With Rng.Areas(i)
     Set TempRng = Union(TempRng, .Resize(, 2).Offset(, 1 - .Column))
   End With
 Next
 k = TempRng.SpecialCells(12).Cells.Count
 MsgBox k, , "Total"
End Sub

Test thử chưa thấy sai chổ nào... nhưng cũng không hiểu tại sao nó ĐÚNG
Vì tuy làm xong vẩn chưa hiểu ở 2 chổ:

Set TempRng = Cells(Rng.Areas(1).Row, 2)

và:

Set TempRng = Union(TempRng, .Resize(, 2).Offset(, 1 - .Column))

Đáng lý ra sau khi Resize vùng thành 2 cột thì kết quả phải chia cho 2 mới đúng chứ... Đàng này khỏi chia nó vẩn ra đúng (chia 2 sẽ sai)
Chả hiểu mình đang NGU chổ nào ??

 

[Po_Pikachu]

Em làm cái này thì chạy tốt nếu các vùng đó không có dòng nào trùng nhau. Tức là 1 (hoặc nhiều dòng) nằm ở cả hai vùng.

Sub Test1() Dim rng As Range Set rng = Application.InputBox(Prompt:="Chon Vung", Type:=8) If rng.Rows.Count = 1 And rng.EntireRow.Hidden = False Then     MsgBox 1 ElseIf rng.Rows.Count = 1 And rng.EntireRow.Hidden = True Then     MsgBox "Khong thoa dieu kien" Else     MsgBox dem(rng) End If End Sub   Function dem(ParamArray rng() As Variant) As Double Dim k As Double Application.Volatile For Each vung In rng         k = Int(vung.SpecialCells(12).Cells.Count / vung.Columns.Count) Next dem = k End Function

Không biết có cách nào để chỉ lấy dòng riêng ở các vùng không? Tức là 1 dòng chỉ tồn tại trên 1 vùng thôi. Nếu có nhiều vùng mà số dòng trùng nhau thì loại nó đi. Kiểu như lấy phần chung lớn nhất vậy. Thân.

 

[ndu96081631]

Em làm cái này thì chạy tốt nếu các vùng đó không có dòng nào trùng nhau. Tức là 1 (hoặc nhiều dòng) nằm ở cả hai vùng.

Sub Test1()
Dim rng As Range
Set rng = Application.InputBox(Prompt:="Chon Vung", Type:=8)
If rng.Rows.Count = 1 And rng.EntireRow.Hidden = False Then
    MsgBox 1
ElseIf rng.Rows.Count = 1 And rng.EntireRow.Hidden = True Then
    MsgBox "Khong thoa dieu kien"
Else
    MsgBox dem(rng)
End If
End Sub
 
Function dem(ParamArray rng() As Variant) As Double
Dim k As Double
Application.Volatile
For Each vung In rng
        k = Int(vung.SpecialCells(12).Cells.Count / vung.Columns.Count)
Next
dem = k
End Function

Không biết có cách nào để chỉ lấy dòng riêng ở các vùng không? Tức là 1 dòng chỉ tồn tại trên 1 vùng thôi. Nếu có nhiều vùng mà số dòng trùng nhau thì loại nó đi. Kiểu như lấy phần chung lớn nhất vậy.
Thân.

Thì code của tôi vừa đưa lên đó... nó đâu có đếm các dòng bị trùng
Vì dụ bạn chọn A1, xong lại chọn A1 rồi lại A1 tiếp (3 lần)... Vậy trong InputBox của bạn hiển thị: $A$1,$A$1,$A$1 nhưng kết quả vẩn = 1 nếu A1 đang hiện và = 0 nếu A1 đang ẩn
Dời tất cả các vùng đến cột A rồi hợp chúng lại bằng Union thì chắc chắn trành được tình trạng bị trùng
Bạn chú ý thêm 1 chuyện quan trọng: Trong Function không thể dùng SpecialCells Method đâu nha

 

[Po_Pikachu]

Vậy sao nó vẩn đúng nhỉ? (Trường hợp quét A1:B3 [A2 ẩn], A4:B5 kết quả là 4) Nhưng trường hợp quét A1:A3 rồi quét B3:B5 thì kết quả là 5 không phải 4. Còn code của bác ra đến 8 lận (quét A1:B3,A4:B5 trong đó dòng 2 là ẩn). Sai quá trời luôn, đúng ra phải là 4 thôi. Ở đây chỉ xét số dòng hiện thôi. Bác nào có cách nạp số dòng duy nhất vào 1 mảng không? Tức là mình quét hai vùng bất kỳ. Mỗi vùng sẽ có số dòng từ đầu này đến đầu kia. Nhưng khi đặt vào mảng arr() chỉ lấy 1 số thôi. Nếu vùng 1 số dòng từ 1 đến 10, vùng 2 số dòng từ 5 đến 11, vùng 3 từ 14 đến 16 thì trong mảng arr() sẽ có các số từ 1 đến 11 và từ 14 đến 16. Em chưa nghỉ ra, mong mọi người giúp thêm với. Thân.

 

[ndu96081631]

Vậy sao nó vẩn đúng nhỉ? (Trường hợp quét A1:B3 [A2 ẩn], A4:B5 kết quả là 4)
Nhưng trường hợp quét A1:A3 rồi quét B3:B5 thì kết quả là 5 không phải 4.
Còn code của bác ra đến 8 lận (quét A1:B3,A4:B5 trong đó dòng 2 là ẩn). Sai quá trời luôn, đúng ra phải là 4 thôi.
Ở đây chỉ xét số dòng hiện thôi.

Bây giờ Test lại thấy sai... Chia 2 thì đúng
Nó là:

Sub RowsVisible()
 Dim Rng As Range, TempRng As Range, i As Long, k As Long
 On Error Resume Next
 Set Rng = Application.InputBox(Prompt:="Chon Vung", Type:=8)
 Set TempRng = Cells(Rng.Areas(1).Row, 2)
 For i = 1 To Rng.Areas.Count
   With Rng.Areas(i)
     Set TempRng = Union(TempRng, .Resize(, 2).Offset(, 1 - .Column))
   End With
 Next
 k = TempRng.SpecialCells(12).Cells.Count / 2
 MsgBox k, , "Total"
End Sub

 

[Po_Pikachu]

S/P: Như vậy không biết khóa sổ phần này được chưa nhỉ? Thân.

 

[ndu96081631]

S/P: Như vậy không biết khóa sổ phần này được chưa nhỉ?
Thân.

Có thể là chưa nếu các cao thủ có cách nào tuyệt nhất (để chúng ta còn học hỏi chứ nhỉ)
Vì dù sao tôi vẩn chưa hài lòng lắm <--- Có 1 chuyện nhỏ mà code dài lê thê!
Hic...