Làm sao lấy được giá trị của dòng phía dưới hàng tiều đề sau khi autofilter)

[Tường_Vi]

Em thử viết đoạn code sau để lấy một giá trị phía dưới tên hàng tiêu đề (không tính dòng bị ẩn) sau khi autofilter
Nhưng khi chạy code dưới nó vẫn lấy giá trị của dòng bị ẩn
Em chưa biết sửa thế nào cho đúng cả. rất mong được trợ giúp

Function ChargeItem(Rng As Range)
Dim clls As Range
With Rng
For Each clls In Rng
    If clls <> "" And _
       clls.Rows.Hidden = False And _
       clls.Columns.Hidden = False Then
       ChargeItem = Rng.Cells(2, 1).Value
       Exit For
    End If
Next clls
End With
End Function

 

[sealand]

Bạn tham khảo bài này của bác SA_DQ

Chú ý đoạn code này:

Sub CopyAFilter()
    Dim Rng As Range    
    With Sheet3
        If Not .FilterMode Then
            MsgBox "AutoFilter?":               Exit Sub
        End If
        [B][COLOR=Red]Set Rng = .AutoFilter.Range.Offset(1, 0).Resize(.AutoFilter.Range.Rows. _
                   Count - 1).SpecialCells(xlCellTypeVisible)[/COLOR][/B]
       [SIZE=3][COLOR=Teal][I]  '[U]set a range = to visible cells (excluding the header)[/U][/I][/COLOR][/SIZE]
        Rng.Copy Destination:=Sheet4.Range("A1")
    End With
End Sub

 

[Tường_Vi]

Em vẫn chưa làm được Anh SeaLand ạh
Mặc dù ý tưởng của em là
- Sau khi filter, lấy những row không ẩn
- Lấy giá trị ngay bên dưới của hàng tiêu đề

Hic, em loay hoay mãi không được

 

[Hai Lúa Miền Tây]

Em vẫn chưa làm được Anh SeaLand ạh
Mặc dù ý tưởng của em là
- Sau khi filter, lấy những row không ẩn
- Lấy giá trị ngay bên dưới của hàng tiêu đề

Hic, em loay hoay mãi không được

Sửa lại như sau:

Function ChargeItem(Rng As Range)
Dim clls As Range
With Rng
For Each clls In Rng
    If clls <> "" And _
       clls.Rows.Hidden = False And _
       clls.Columns.Hidden = False Then
       ChargeItem = clls.Value
       Exit For
      
    End If
Next clls
End With
End Function

 

[sealand]

Bạn tham khảo code trong file

code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
If Target.Address = "$E$1" Then
Application.ScreenUpdating = False
With Sheet1
.Columns("G:H").ClearContents
Range("A1:B33").AutoFilter Field:=1, Criteria1:="=" & [E1] & "*"
Set Rng = .AutoFilter.Range.Offset(1, 0).Resize(.AutoFilter.Range.Rows. _
Count - 1).SpecialCells(xlCellTypeVisible)
Rng.Copy Destination:=Sheet2.Range("A1")
Range("A1:B33").AutoFilter
Rng.Copy Destination:=.Range("G1")
Application.ScreenUpdating = True
End With
End If
End Sub

 

[Tường_Vi]

Hi hi, Anh Dom wear footer sửa lại code cho muội chạy ngon rồi.
Thường em hay phải dùng bằng tay nhưng giờ ok rồi

Em cám ơn Các Ka ka nhiều

 

[ndu96081631]

Em thử viết đoạn code sau để lấy một giá trị phía dưới tên hàng tiêu đề (không tính dòng bị ẩn) sau khi autofilter
Nhưng khi chạy code dưới nó vẫn lấy giá trị của dòng bị ẩn
Em chưa biết sửa thế nào cho đúng cả. rất mong được trợ giúp

Function ChargeItem(Rng As Range)
Dim clls As Range
With Rng
For Each clls In Rng
    If clls <> "" And _
       clls.Rows.Hidden = False And _
       clls.Columns.Hidden = False Then
       ChargeItem = Rng.Cells(2, 1).Value
       Exit For
    End If
Next clls
End With
End Function

Bài toán này khuyên bạn không nên dùng Function mà nên dùng Sub ---> Khi ấy ta sẽ tận dụng được phương thức SpecialCells và thuộc tính Areas để làm mà không cần bất cứ vòng lập nào
Ví dụ:
- SrcRng là vùng dữ liệu
===> Intersect(SrcRng, SrcRng.Offset(1)) chính là vùng ngay bên dưới tiêu đề (sau khi filter)
===> Chỉ cần lấy SpecialCells(12).Areas(1).Resize(1) của vùng này thì sẽ còn lại 1 dòng, chính là dòng mà ta cần lấy dữ liệu
Đại khái code thế này:

Sub Test()
  With ActiveSheet.AutoFilter.Range
    With Intersect(.Cells, .Offset(1))
      Range("B1:D1") = .SpecialCells(12).Areas(1).Resize(1).Value
    End With
  End With
End Sub

Ngon ăn không?

 

[Tường_Vi]

Bài toán này khuyên bạn không nên dùng Function mà nên dùng Sub ---> Khi ấy ta sẽ tận dụng được phương thức SpecialCells và thuộc tính Areas để làm mà không cần bất cứ vòng lập nào
Ví dụ:
- SrcRng là vùng dữ liệu
===> Intersect(SrcRng, SrcRng.Offset(1)) chính là vùng ngay bên dưới tiêu đề (sau khi filter)
===> Chỉ cần lấy SpecialCells(12).Areas(1).Resize(1) của vùng này thì sẽ còn lại 1 dòng, chính là dòng mà ta cần lấy dữ liệu
Đại khái code thế này:

Sub Test()
  With ActiveSheet.AutoFilter.Range
    With Intersect(.Cells, .Offset(1))
      Range("B1:D1") = .SpecialCells(12).Areas(1).Resize(1).Value
    End With
  End With
End Sub

Ngon ăn không?

Returns an Areas collection that represents all the ranges in a multiple-area selection. Read-only.

Điều bác nói có nghĩa là specialcell không dùng được trong UDF? Hic buồn cười nhỉ??
Em chưa hiểu Areas, tuy nhiên đã đọc trong help những chưa hiểu tại sao phải thêm Areas vào giữa Anh nhỉ?
Hay có phải nó nỗi các range lại với nhau thành một range không?

 

[sealand]

Giờ mình mới hiểu ý bạn chỉ cần dòng đầu tiên thoả mãn điều kiện lọc. Vậy thì tất cả các biện pháp ở đây mình cho rằng không hợp lý, khác nào mang đại đao mổ gà. Theo mình bạn viết hàm sử dụng phương thức find là tốt rồi, thậm chí bỏ cả vòng lập mà chỉ câng dòng đầu tiên mà thôi. Nhanh, gọn và chính xác cũng không kém Filter. Ví dụ:

Option Explicit
Function tim(rg As Range, ch As String, k As Integer)
Dim c As Range
Set c = rg.Find(ch & "*", LookIn:=xlValues)
    If Not c Is Nothing Then tim = IIf(k = 0, c.Text, c.Offset(, k))
End Function

Đây là viết code thôi chứ vấn đề này công thức giải quyết gọn
Cám ơn Ndu là người phát hiện vấn đề

 

[ndu96081631]

Điều bác nói có nghĩa là specialcell không dùng được trong UDF? Hic buồn cười nhỉ??

Đúng vậy, SpecialCells không dùng được cho UDF, đó là quy định từ MS

Em chưa hiểu Areas, tuy nhiên đã đọc trong help những chưa hiểu tại sao phải thêm Areas vào giữa Anh nhỉ?
Hay có phải nó nỗi các range lại với nhau thành một range không?

Areas là KHU VỰC (dể hiểu)
khi ta ẩn dòng, cột rồi dùng SpecialCells(12) để lấy vùng Visible thì có khả năng vùng này đã bị chia cắt, tức không liền kề nhau (bị ngăn cách bời các vùng ẩn), đúng không? ---> Mà Resize thì chỉ làm việc được với 1 vùng liên tục mà thôi ---> Chính thế mà ta phải dùng Areas(1) để lấy ra khu vực đầu tiên, sau đó mới Resize
Thí nghiệm bỏ Areas sẽ thấy lỗi liền (nếu như SpecialCells(12) xuất ra 1 vùng không liên tục trước đó)

 

[ptm0412]

Cho hỏi chen ngang 1 cái nhen:

có khả năng vùng này đã bị chia cắt, tức không liền kề nhau , ... Chính thế mà ta phải dùng Areas(1) để lấy ra khu vực đầu tiên, ...

Vậy nếu các vùng bị không liền kề nhau, không ngay hàng thẳng lối như trong autofilter, mà so le trái phải, trên dưới, thậm chí cùng dòng đầu mà khác cột, ... thì thứ tự Areas(i) lấy theo phương pháp nào?

Xin cám ơn trước.

 

[ndu96081631]

Cho hỏi chen ngang 1 cái nhen:


Vậy nếu các vùng bị không liền kề nhau, không ngay hàng thẳng lối như trong autofilter, mà so le trái phải, trên dưới, thậm chí cùng dòng đầu mà khác cột, ... thì thứ tự Areas(i) lấy theo phương pháp nào?

Xin cám ơn trước.

Vụ này nhớ không lầm anh TrungChinh đã hỏi 1 lần
Rất khó biết sư phụ à!
Sư phụ cứ thử code này:

Sub Test()
  Dim Rng As Range, i As Long
  Set Rng = Selection
  For i = 1 To Rng.Areas.Count
    Rng.Areas(i).Select
    MsgBox "Tiep"
  Next
End Sub

Sư phụ dùng chuột quét chọn nhiều vùng không liên tục nhau rồi chạy code, sư phụ sẽ thấy nó làm việc theo thứ tự như ta đã hành động... Tức ta quét cái nào trước nó sẽ xem là Areas(1)

 

[Tường_Vi]

Đúng vậy, SpecialCells không dùng được cho UDF, đó là quy định từ MS


Areas là KHU VỰC (dể hiểu)
khi ta ẩn dòng, cột rồi dùng SpecialCells(12) để lấy vùng Visible thì có khả năng vùng này đã bị chia cắt, tức không liền kề nhau (bị ngăn cách bời các vùng ẩn), đúng không? ---> Mà Resize thì chỉ làm việc được với 1 vùng liên tục mà thôi ---> Chính thế mà ta phải dùng Areas(1) để lấy ra khu vực đầu tiên, sau đó mới Resize
Thí nghiệm bỏ Areas sẽ thấy lỗi liền (nếu như SpecialCells(12) xuất ra 1 vùng không liên tục trước đó)

Cám ơn Anh nhiều, em định hỏi offset không giống resize (không góc độ làm việc với vùng liên tục) không? nhưng thôi...như vậy tham quá
Em sẽ tự test thí nghiệm lấy, có gì không hiểu hỏi tiếp

 

[mhdenhat]

Hi hi, Anh Dom wear footer sửa lại code cho muội chạy ngon rồi.
Thường em hay phải dùng bằng tay nhưng giờ ok rồi

Em cám ơn Các Ka ka nhiều

Hi chị,

Chị chia sẻ giúp em đoạn code cuối cùng nha.

Em cảm ơn ạ.