Làm Bảng tổng hợp tự động

[interwar1283]

Mình đang muốn làm bảng tổng hợp tự động (như trình bày trong file đính kèm). Bạn nào biết chỉ giúp mình với.
http://www.giaiphapexcel.com/forum/n...newthread&f=80

 

[interwar1283]

Mình không để ý Link file , mình up lên bị hỏng. Mình up lại các bạn giúp mình nhé.
http://galaxyz.net/data/744640404c404543/DT.xls.glx
Hoặc:
http://www.filedropper.com/dt

 

[SA_DQ]

Bạn xài font gì vậy, mình không đọc được luôn

Macro của bạn đây, xin mời

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("A5:A13")) Is Nothing Then
   Dim jJ As Byte:               Dim MyAdd As String, TangDT As String
   Dim Sh As Worksheet, Rng As Range, sRng As Range
   Dim Clls As Range, Rng0 As Range
   
   Set Sh = Sheets("Tinh Toan"):          TangDT = Sh.Range("TangDTV").Value
   Set Rng = Sh.Range(Sh.[B7], Sh.[B65500].End(xlUp))
   Set sRng = Rng.Find(TangDT, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      MyAdd = sRng.Address
      Do
         jJ = jJ + 1
         If jJ = Target.Value Then
            Set Rng0 = sRng.Offset(-5).Resize(30):            Exit Do
         End If
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   End If
   MsgBox Rng0.Address
   For Each Clls In Rng0
      If InStr(Clls.Value, "DT V") > 0 Then
         Target.Offset(, 2).Value = Clls.Offset(, 1).Value
         Target.Offset(, 1).Value = Clls.Offset(-2, 1).Value
      ElseIf InStr(Clls.Value, "DT CHN:") > 0 Then
         Target.Offset(, 3).Value = Clls.Offset(, 1).Value
      ElseIf InStr(Clls.Value, "TH DA") > 0 Then
         Target.Offset(, 4).Value = Clls.Offset(, 1).Value
      ElseIf InStr(Clls.Value, "TH ") > 0 And InStr(Clls.Value, "TH D") = 0 Then
         Target.Offset(, 5).Value = Clls.Offset(, 1).Value
      ElseIf InStr(Clls.Value, "AAA:") > 0 Then
         Target.Offset(, 8).Value = Clls.Offset(, 6).Value
      ElseIf InStr(Clls.Value, "BBB:") > 0 Then
         Target.Offset(, 9).Value = Clls.Offset(, 6).Value
      ElseIf InStr(Clls.Value, "zz") > 0 Then
         Target.Offset(, 10).Value = Clls.Offset(, 6).Value
      ElseIf InStr(Clls.Value, "aa ab") > 0 Then
         Target.Offset(, 11).Value = Clls.Offset(, 6).Value
      ElseIf InStr(Clls.Value, "ac ad") > 0 Then
         Target.Offset(, 12).Value = Clls.Offset(, 6).Value
      End If
   Next Clls
 End If
End Sub

Chú ý: Để macro chạy đúng, bạn hãy chọn ô [B8] của trang "Tinh Toan" & gán nó có cái tên TangDTV (Nếu bạn không thích tên như vậy thì tên bạn thích fải được sửa tương ứng trong macro

Chúc thành công!

 

[interwar1283]

Mình cũng tập tọe excel thôi, cách đưa macro vào như thế nào bạn nhỉ, mình chưa biết cách, bạn hướng dẫn cho mình với.

 

[SA_DQ]

Đó là macro sự kiện tại trang tính "Bang TH"

Vắn tắc cách làm như sau: (E2K3)

Bạn fải chuột vô ngăn "Bang TH" của thanh mà người ta hay gọi là SheetName (Ở góc trái fía dưới màn hình í)
Khi cửa sổ hiện ra, ta chọn dòng cuối.

Bạn copy macro này lên cửa sổ đó;
(Còn 1 việc nữa, là nhớ gán tên cho ô [B8] như bài trên nha)

Sau đó bạn cứ việc nhập số thứ tự tùy thích lên 1 trong các ô từ 'A5:A13 để chiêm ngưỡng cảnh đẹp do macro đem lại

Chúc bạn thành công hơn nữa với macro này!