Giúp mình trộn ô với (1 người xem)

[quanvantruong]

Mình có danh sách các hộ dân (khoảng 10.000 hộ). Dữ liệu gốc người ta cung cấp cho mình như bảng A, bây giờ mình muốn nó trở thành như bảng B mà không phải làm thủ công từng cái 1 - vì nó quá nhiều, làm thủ công thì không xuể. Xin mọi người giúp với ạ.

 

[app]

It's yours!
Enable Macro, chạy Macro01. Macro sẽ merge trực tiếp trên sheet dữ liệu đang mở. (Cột B, C)

Chú ý là chỉ chạy trên file dữ liệu được copy thôi nhé để tránh chương trình thực hiện không đúng ý đồ. Và dữ liệu phải đồng nhất từ hàng bắt đầu (From - 6) đến hàng kết thúc (To - 25). Nghĩa là các dòng giữa 2 hàng này phải chưa Merge.

 

[quanvantruong]

Mình chạy cái macro mãi mà không được ... nó cứ load hoài à, bạn giúp mình với, mình cám ơn nhiều.

 

[app]

Xin lỗi bạn vì mình chưa test trên số lượng dòng nhiều nên không lường được tình huống của bạn. Sau khi làm test với dữ liệu thuần (không có công thức) chương trình chạy:

• 5385 dòng hết 5s.
• 10874 dòng hết 12s.

10 ngàn hộ nếu không nhầm sẽ ứng với khoảng 40 ngàn dòng. Vậy theo tốc độ ở trên thì macro sẽ tốn khoảng hơn 40s. Trường hợp dữ liệu của bạn có chứa công thức hoặc cấu hình máy thấp thì có thể thời gian sẽ dài hơn nhiều lần so với từng đó.

Nếu không đủ kiên nhẫn thì bạn vui lòng chạy từng đoạn, ví dụ 6-1000, 1001-2000, 2000-3001... Sau khi chạy xong các đoạn này, vui lòng kiểu tra lại các dòng 1000-1001, 2000-2001...

Một điểm nữa là kể cả ô đã được Merge thì chương trình vẫn chạy được với điều kiện ô xử lý kế bên cũng được Merge tương ứng. Chú là phải nhập chính xác dòng bắt đầu và kết thúc.

 

[Quang_Hải]

Mình có danh sách các hộ dân (khoảng 10.000 hộ). Dữ liệu gốc người ta cung cấp cho mình như bảng A, bây giờ mình muốn nó trở thành như bảng B mà không phải làm thủ công từng cái 1 - vì nó quá nhiều, làm thủ công thì không xuể. Xin mọi người giúp với ạ.

Thử code này xem thế nào

Sub tron_cell()
Application.DisplayAlerts = False
Dim dl(), i As Long, kq As Range, tam
dl = Range([C7], [c65536].End(3)).Value
Set kq = Range([C7], [c65536].End(3))
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(dl)
      If Not .exists(dl(i, 1)) Then .Add dl(i, 1), ""
   Next
   tam = .keys
End With
For i = 0 To UBound(tam)
   With kq
      .AutoFilter 1, tam(i)
      .MergeCells = True
      .VerticalAlignment = xlCenter
      .Offset(, -1).MergeCells = True
      .Offset(, -1).VerticalAlignment = xlCenter
      .Offset(, -1).HorizontalAlignment = xlCenter
      .AutoFilter
   End With
Next
Application.DisplayAlerts = True
End Sub