Merge và đánh số thứ tự trong dãy ô đã merge???

[tomato_qs]

Mình có 1 file như sau, mình muốn trộn ô và đánh số thứ tự như như trong file, nhưng vì file của mình rất lớn, nên làm bằng tay thì lâu quá. Mình chỉ có thể khắc phục được bằng cách tạo menu trộn ô (Bôi đen các ô -> ấn Alt-M) thôi, nhưng vẫn lâu lắm.
Còn đánh số thứ tự các ô đã trộn, thì cũng ko kéo được như bình thường? cứ phải đánh = tay.
Các bạn có cách nào nhanh, giúp mình nhé. Chân thành cám ơn.

 

[nm1000kg]

Mình giải quyết bài này như vầy bạn thấy được không

 

[huuthang_bd]

Mình có 1 file như sau, mình muốn trộn ô và đánh số thứ tự như như trong file, nhưng vì file của mình rất lớn, nên làm bằng tay thì lâu quá. Mình chỉ có thể khắc phục được bằng cách tạo menu trộn ô (Bôi đen các ô -> ấn Alt-M) thôi, nhưng vẫn lâu lắm.
Còn đánh số thứ tự các ô đã trộn, thì cũng ko kéo được như bình thường? cứ phải đánh = tay.
Các bạn có cách nào nhanh, giúp mình nhé. Chân thành cám ơn.

Chạy code này nhé:

Sub Merge()
Dim Rng1 As Range
Application.DisplayAlerts = False
i = 1
Set Rng1 = [B2]
For Each Rng In ActiveSheet.Range([B2], [B65536].End(xlUp))
    If Rng <> Rng.Offset(1) Then
    Rng1.Offset(, -1).Value = i
        With Range(Rng1, Rng)
        .Offset(, -1).Merge
        .Offset(, 1).Merge
        .Merge
        End With
    i = i + 1
    Set Rng1 = Rng.Offset(1)
    End If
Next
Application.DisplayAlerts = True
End Sub

Nhớ sửa code cho phù hợp với dữ liệu thật.

 

[ndu96081631]

Chạy code này nhé:

Sub Merge()
Dim Rng1 As Range
Application.DisplayAlerts = False
i = 1
Set Rng1 = [B2]
For Each Rng In ActiveSheet.Range([B2], [B65536].End(xlUp))
    If Rng <> Rng.Offset(1) Then
    Rng1.Offset(, -1).Value = i
        With Range(Rng1, Rng)
        .Offset(, -1).Merge
        .Offset(, 1).Merge
        .Merge
        End With
    i = i + 1
    Set Rng1 = Rng.Offset(1)
    End If
Next
Application.DisplayAlerts = True
End Sub

Nhớ sửa code cho phù hợp với dữ liệu thật.

Cái này nếu cẩn thận ta nên sort cột B trước, nếu không thể thể.. toi (nếu chẳng may có vài cell nào đó xếp lộn)
Ngoài ra còn cách khác:
- Sort lại dử liệu gốc theo cột B
- Lọc dử liệu gốc ra 1 danh mục duy nhất
- Quét các cell trong danh mục duy nhất này
- Dùng hàm MATCH và COUNTIF để định vị các vùng cần Merge (hoặc có thể dùng AutoFilter)
==> Như vậy số lần lập trong vòng lập sẽ ít hơn rất nhiều so với cách duyệt từng cell

 

[tomato_qs]

Cám ơn huuthang_bd nhé, minh làm được rồi (tuy chưa hiểu lắm về code )
To ndu96081631: Mình kiểm tra thì chưa thấy lỗi gì, bạn có thể nói rõ cho mình nguy cơ lỗi không?
Cám ơn các bạn rất nhiều!

 

[ndu96081631]

Cám ơn huuthang_bd nhé, minh làm được rồi (tuy chưa hiểu lắm về code )
To ndu96081631: Mình kiểm tra thì chưa thấy lỗi gì, bạn có thể nói rõ cho mình nguy cơ lỗi không?
Cám ơn các bạn rất nhiều!

Giả sử cột B của bạn chưa được sort trước (tức nó nằm lộn xộn thì bạn nghĩ code trên có chạy đúng không?
Bạn cứ thử làm cho cột B lộn xộn rồi chạy code xem thì biết liền
Đây là code tôi đề xuất:

Sub MergeRng()
  Dim Clls As Range, Temp As String, Arr, i As Long, Func As WorksheetFunction
  Application.DisplayAlerts = False
  Set Func = Application.WorksheetFunction
  With Range(Sheet1.[B2], Sheet1.[B65536].End(xlUp))
    .Resize(, 3).Sort .Cells(1, 1), 1, Header:=xlNo
    .AdvancedFilter 1, , , True
    For Each Clls In Intersect(.Cells, .Offset(1)).SpecialCells(12)
      Temp = Temp & Chr(10) & Clls
    Next
    .Parent.ShowAllData
    Arr = Split(Mid(Temp, 2, Len(Temp)), Chr(10))
    For i = 0 To UBound(Arr)
      With .Cells(Func.Match(Arr(i), .Cells, 0)).Resize(Func.CountIf(.Cells, Arr(i)))
        .Offset(, -1).Merge: .Offset(, -1) = i + 1: .Offset(, 1).Merge: .Merge
        .Offset(, -1).VerticalAlignment = xlCenter
        .Offset(, 1).VerticalAlignment = xlCenter
        .VerticalAlignment = xlCenter
      End With
    Next i
  End With
  Application.DisplayAlerts = True
End Sub

Có thể bạn thấy code khá dài, nhưng bảo đảm chạy nhanh gấp nhiều lần so với cách quét qua từng cell

 

[tomato_qs]

Cảm ơn ndu96081631rất nhiều, mình đã thử các trường hợp bạn nói, đúng là nếu sắp lộn xộn thì code của huuthang_bd bị lỗi. Code của bạn vẫn giải quyết vấn đề ngon lành. Một lần nữa cám ơn bạn nhé.
Mình sẽ ngâm cứu code này xem có thủng ko.

 

[volga]

Bạn xem thử cái này nhe ,không biết mình có hiểu đúng câu hỏi không ?
Trước hết hãy chọn hết vùng dử liệu cần đánh số thứ tự .Trong File ô màu vàng là ô Merge .
Viết công thức xong rồi bấm Ctrl+Enter để kết thúc công thức .
A3 Rổng .

 

[ndu96081631]

Bạn xem thử cái này nhe ,không biết mình có hiểu đúng câu hỏi không ?
Trước hết hãy chọn hết vùng dử liệu cần đánh số thứ tự .Trong File ô màu vàng là ô Merge .
Viết công thức xong rồi bấm Ctrl+Enter để kết thúc công thức .
A3 Rổng .

Volga xem lại, ý tác giả là xét cột B và C rồi merge tất cả những dử liệu giống nhau lại thành 1... Sau khi đã Merge thì mới đánh STT tại cột A ---> cái vụ merge mới quan trọng nhất... Vì thế bài này ăn chắc không thể làm bằng công thức được đâu (chạy code trong file đính kèm của tôi sẽ hiểu được vấn đề)

 

[hazelpham]

Giờ em muốn đánh số thứ tự cho file này thì sao vậy anh, em làm theo hướng dẫn ở trên mà không được http://www.mediafire.com/?xbl41i3n8ag8sal

 

[trinhvh91]

Cái này nếu cẩn thận ta nên sort cột B trước, nếu không thể thể.. toi (nếu chẳng may có vài cell nào đó xếp lộn)
Ngoài ra còn cách khác:
- Sort lại dử liệu gốc theo cột B
- Lọc dử liệu gốc ra 1 danh mục duy nhất
- Quét các cell trong danh mục duy nhất này
- Dùng hàm MATCH và COUNTIF để định vị các vùng cần Merge (hoặc có thể dùng AutoFilter)
==> Như vậy số lần lập trong vòng lập sẽ ít hơn rất nhiều so với cách duyệt từng cell

Cậu ơi tớ ko làm được, hic, tớ lại hay insert thêm nhiều row nữa nên ko làm được

 

[tiendo1988]

Đã được giúp đỡ ở topic khac..

 

[nguyenquocvinh1102]

Cám ơn bác nhiều lắm, hí hí.
E tìm mãi mà ko nghĩ ra cách này há há

 

[friendlyn7]

Bạn xem thử cái này nhe ,không biết mình có hiểu đúng câu hỏi không ?
Trước hết hãy chọn hết vùng dử liệu cần đánh số thứ tự .Trong File ô màu vàng là ô Merge .
Viết công thức xong rồi bấm Ctrl+Enter để kết thúc công thức .
A3 Rổng .

Tks volga nhá. Bạn đúng là siu nhưn mình tìm lòi mắt từ hôm qua trên mạng mà không thấy.

 

[tuanna.kgg]

Chào anh! anh giỏi quá, xin được chỉ giáo, cám ơn anh!

 

[tuanna.kgg]

Chào anh ndu96081631