[Hỏi] Sub Merge trong excell (1 người xem)

[tranly_dienchau]

Xin ace chỉ giúp mình với! mình cần viết code để: nếu trong danh sách có các tên trùng nhau thì nó sẽ merge lại như file ví dụ này vậy. Sau khi merge lại thì nó sẽ đánh số thứ tự từ 1 đến hết. Cảm ơn ace đã theo dõi và giúp đỡ mình.

 

[Quang_Hải]

Xin ace chỉ giúp mình với! mình cần viết code để: nếu trong danh sách có các tên trùng nhau thì nó sẽ merge lại như file ví dụ này vậy. Sau khi merge lại thì nó sẽ đánh số thứ tự từ 1 đến hết. Cảm ơn ace đã theo dõi và giúp đỡ mình.

Code đây

Sub tron_cell()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim dl(), i As Long, kq As Range, tam
dl = Range([B1], [B65536].End(3)).Value
Set kq = Range([B1], [B65536].End(3))
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(dl)
      .Item(dl(i, 1)) = ""
   Next
   tam = .keys
End With
For i = UBound(tam) To 0 Step -1
   With kq
      .AutoFilter 1, tam(i)
      .MergeCells = True
      .Offset(, -1).MergeCells = True
      .Offset(, -1) = i + 1
      .AutoFilter
   End With
Next
kq.VerticalAlignment = xlCenter
kq.Offset(, -1).VerticalAlignment = xlCenter
kq.Offset(, -1).HorizontalAlignment = xlCenter
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[ndu96081631]

Bài này mà không sort dữ liệu trước khi xử lý thì có khả năng "die" toàn tập (khi gặp vận xui dữ liệu trùng không nằm gần nhau)

 

[Quang_Hải]

Bài này mà không sort dữ liệu trước khi xử lý thì có khả năng "die" toàn tập (khi gặp vận xui dữ liệu trùng không nằm gần nhau)

Kệ đi anh à, khi bị "die" thì tự nhiên người ấy chạy lên diễn đàn thôi mà.
Chưa biết khi nào người ta quay vô diễn đàn nhặt đáp án nữa cơ.

 

[tranly_dienchau]

Xin cảm ơn bạn ndu96081631 nhiều nha. Vì mình mới đăng câu hỏi này hôm qua, không ngờ bạn ndu96081631 giúp mình nhanh đến vậy mà.. Chứ không như quanghai1969 ngĩ đâu. Đã hỏi thì ai mà chẳng mong được người khác giúp đỡ chứ.. Nhưng cũng rất cảm ơn quanghai1969 đã nhắc nhở nữa..Xin cảm ơn mọi người một lần nữa. Và rất vui vì mình đã tìm thấy một diễn đàn rất bổ ích này..

 

[tranly_dienchau]

Mình xin được hỏi thêm là: vì cái code ndu96081631 viết này, khi chạy là nó đè lên cái danh sách tên cũ của mình nên mình không theo dõi được ấy. thế nên mình phải copy cột danh sách cũ lại và dán sang cột bên cạnh để theo dõi nó sau khi chạy code PHP đó. Vì mình có nhiều sheet phải làm như vậy lắm, mà cứ copy rồi dán thế thì rất lâu. Có cách nào mà sau khi chạy code đó thì nó sẽ ra cái mình cần mà nằm ở 2 cột bên cạnh cột danh sách cũ của mình đang có không nhỉ(tức là giữ lại cột danh sách cũ chứ đừng có đè lên cột danh sách cũ ấy)?

 

[Quang_Hải]

Xin cảm ơn bạn ndu96081631 nhiều nha. Vì mình mới đăng câu hỏi này hôm qua, không ngờ bạn ndu96081631 giúp mình nhanh đến vậy mà.. Chứ không như quanghai1969 ngĩ đâu. Đã hỏi thì ai mà chẳng mong được người khác giúp đỡ chứ.. Nhưng cũng rất cảm ơn quanghai1969 đã nhắc nhở nữa..Xin cảm ơn mọi người một lần nữa. Và rất vui vì mình đã tìm thấy một diễn đàn rất bổ ích này..

Thiệt là đau lòng quá đi. Code của tui viết mà cảm ơn anh NDU "không ngờ bạn ndu96081631 giúp mình nhanh đến vậy". Tức tức tức... ka ka ka. Ủa mà tui có nhắc nhở gì đâu ta "Nhưng cũng rất cảm ơn quanghai1969 đã nhắc nhở nữa."

 

[tranly_dienchau]

Bạn có thể tạm dịch cái đoạn code này giúp mình được không:
tam
dl = Range([B1], [B65536].End(3)).Value
Set kq = Range([B1], [B65536].End(3))
With CreateObject("scripting.dictionary")
For i = 1 To UBound(dl)
.Item(dl(i, 1)) = ""
Next
tam = .keys

 

[tranly_dienchau]

hihihi.. ak, nhầm xíu mà... xin lỗi quanghai1969 nha.. xin lỗi bạn.. .. và cảm ơn bạn vì đã giúp mình được rất nhiều.. hậu tạ 1 ly cà phê nhé?

 

[Quang_Hải]

Mình xin được hỏi thêm là: vì cái code ndu96081631 viết này, khi chạy là nó đè lên cái danh sách tên cũ của mình nên mình không theo dõi được ấy. thế nên mình phải copy cột danh sách cũ lại và dán sang cột bên cạnh để theo dõi nó sau khi chạy code PHP đó. Vì mình có nhiều sheet phải làm như vậy lắm, mà cứ copy rồi dán thế thì rất lâu. Có cách nào mà sau khi chạy code đó thì nó sẽ ra cái mình cần mà nằm ở 2 cột bên cạnh cột danh sách cũ của mình đang có không nhỉ(tức là giữ lại cột danh sách cũ chứ đừng có đè lên cột danh sách cũ ấy)?

Tiễn bạn thêm 1 đoạn nữa

Sub tron_cell()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim dl(), i As Long, kq As Range, tam
With Range([B1], [B65536].End(3))
   .SortSpecial
   dl = .Value
   .Offset(, 2) = .Value
   Set kq = .Offset(, 2)
End With
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(dl)
      .Item(dl(i, 1)) = ""
   Next
   tam = .keys
End With
For i = UBound(tam) To 0 Step -1
   With kq
      .AutoFilter 1, tam(i)
      .MergeCells = True
      .Offset(, -1).MergeCells = True
      .Offset(, -1) = i + 1
      .AutoFilter
   End With
Next
kq.VerticalAlignment = xlCenter
kq.Offset(, -1).VerticalAlignment = xlCenter
kq.Offset(, -1).HorizontalAlignment = xlCenter
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[tranly_dienchau]

Xin cảm ơn thầy quanghai1969 rất nhiều.