Không dùng VBA thì có thể dùng hàm được???

[tiencds]

Nhờ các anh, chị xem file sau thì có thể dùng hàm nào để lập được công thức theo yêu cầu?

 

[SA_DQ]

Mình không thể làm bằng công thức, hãy xem tạm cái ni, như là 1 tham khảo vui

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [D18]) Is Nothing Then
   Dim Sh As Worksheet, Rng As Range, sRng As Range, Clls As Range
   Dim Col As Byte
   
   Set Sh = Sheets("Sheet2"):             Sheets("vd").Select
   Set Rng = Sh.Range("LyTrinh").Find([D18].Value, , xlFormulas, xlWhole).Offset(, 3)
   Set sRng = Sh.Range(Rng, Sh.Cells(Rng.Row, "IV").End(xlToLeft))
   Set Rng = Union(sRng.SpecialCells(xlCellTypeConstants, 3), _
      sRng.SpecialCells(xlCellTypeFormulas, 3))
   [B23].Resize(30, 8).ClearContents
   For Each Clls In Rng
      Col = Clls.Column
      With [B99].End(xlUp).Offset(1)
         .Value = Sh.Cells(2, Col).Value
         .Offset(, 1).Value = Sh.Cells(6, Col).Value
         .Offset(, 2).Value = Clls.Value
      End With
   Next Clls
 End If
End Sub

 

[ptm0412]

Muốn công thức thì xài cái này. Công thức cũng nhẹ nhàng thôi.

 

[ndu96081631]

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [D18]) Is Nothing Then
   Dim Sh As Worksheet, Rng As Range, sRng As Range, Clls As Range
   Dim Col As Byte
   
   Set Sh = Sheets("Sheet2"):             Sheets("vd").Select
   Set Rng = Sh.Range("LyTrinh").Find([D18].Value, , xlFormulas, xlWhole).Offset(, 3)
   Set sRng = Sh.Range(Rng, Sh.Cells(Rng.Row, "IV").End(xlToLeft))
   Set Rng = Union(sRng.SpecialCells(xlCellTypeConstants, 3), _
      sRng.SpecialCells(xlCellTypeFormulas, 3))
   [B23].Resize(30, 8).ClearContents
   For Each Clls In Rng
      Col = Clls.Column
      With [B99].End(xlUp).Offset(1)
         .Value = Sh.Cells(2, Col).Value
         .Offset(, 1).Value = Sh.Cells(6, Col).Value
         .Offset(, 2).Value = Clls.Value
      End With
   Next Clls
 End If
End Sub

Thi với sư phụ!
Em dùng PasteSpecial\Transpose ---> Khỏi vòng lập!

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Sh As Worksheet
  If Not Intersect(Target, [D4]) Is Nothing Then
    Range("A9:E10000").ClearContents
    Set Sh = Sheets("Sheet2")
    On Error GoTo ExitSub
    With Sh.Range("LyTrinh").Find([D4].Value, , , xlWhole)
      Range("D5").Value = .Offset(, 1).Value
      Range("D6").Value = .Offset(, 2).Value
      With .Offset(, 3).Resize(, Sh.Range("VatTu").Columns.Count)
        .SpecialCells(2).Copy: Range("D9").PasteSpecial 3, , , True
        Intersect(.SpecialCells(2).EntireColumn, Sh.Range("VatTu").Resize(2)).Copy
        Range("B9").PasteSpecial 3, , , True
      End With
    End With
    With Range([B9], [B65536].End(xlUp))
      .Offset(, -1).Value = Evaluate("ROW(R:R)")
    End With
    Target.Select
    Application.CutCopyMode = False
  End If
ExitSub:
End Sub

 

[ndu96081631]

Và đây là cách dùng công thức, không vùng phụ
(vẫn dựa trên file của sư phụ HYen17, vì font Unicode dể nhìn hơn)
Xem file

 

[tam8678]

Thi với sư phụ!
Em dùng PasteSpecial\Transpose ---> Khỏi vòng lập!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As Worksheet
If Not Intersect(Target, [D4]) Is Nothing Then
Range("A9:E10000").ClearContents
Set Sh = Sheets("Sheet2")
On Error GoTo ExitSub
With Sh.Range("LyTrinh").Find([D4].Value, , , xlWhole)
Range("D5").Value = .Offset(, 1).Value
Range("D6").Value = .Offset(, 2).Value
With .Offset(, 3).Resize(, Sh.Range("VatTu").Columns.Count)
.SpecialCells(2).Copy: Range("D9").PasteSpecial 3, , , True
Intersect(.SpecialCells(2).EntireColumn, Sh.Range("VatTu").Resize(2)).Copy
Range("B9").PasteSpecial 3, , , True
End With
End With
With Range([B9], [B65536].End(xlUp))
.Offset(, -1).Value = Evaluate("ROW(R:R)")
End With
Target.Select
Application.CutCopyMode = False
End If
ExitSub:
End Sub

---
Cho anh hỏi: có 2 name hả chú?

 

[ndu96081631]

---
Cho anh hỏi: có 2 name hả chú?

Đúng rồi anh à! Vì em dựa trên file của sư phụ, name có sẳn
Với dử liệu khác, ta sửa lại tham chiếu của 2 name này là được
--------------------------
Bài này còn 1 chiêu nữa không dùng Find ---> Ta dùng AutoFilter lọc dử liệu theo điều kiện tại Validation, xong ta copy 1 phát 1 toàn bộ (nhưng cell có dữ liệu) rồi Paste special\Transpose là xong

 

[tam8678]

Đúng rồi anh à! Vì em dựa trên file của sư phụ, name có sẳn
Với dử liệu khác, ta sửa lại tham chiếu của 2 name này là được
--------------------------
Bài này còn 1 chiêu nữa không dùng Find ---> Ta dùng AutoFilter lọc dử liệu theo điều kiện tại Validation, xong ta copy 1 phát 1 toàn bộ (nhưng cell có dữ liệu) rồi Paste special\Transpose là xong

---
Dữ liệu thì luôn cập nhật => cho name nó"động đậy" đi chú.

Bài này còn 1 chiêu

....ra chiêu đi chú (để ...học lóm chứ)

 

[ndu96081631]

---
Dữ liệu thì luôn cập nhật => cho name nó"động đậy" đi chú.

....ra chiêu đi chú (để ...học lóm chứ)

Name động dể mà anh, chẳng hạn

LyTrinh =OFFSET(Sheet2!$B$4,,,COUNTA(Sheet2!$B$4:$B$10000),)