Gộp các hàng giống nhau lại một hàng (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Tham khảo code đính kèm.
Mã:
Sub GpeMerge()
Dim sArr(), i As Long, j As Long, k As Long, Tmp As String, Dic As Object, reArr()
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Sheets("2").range("B4:W" & Sheets("2").range("B65535").End(xlUp).Row).Value
ReDim reArr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2) + 1)
Sheets("GPE").range("A4:W65535").ClearContents
For i = 1 To UBound(sArr, 1)
    Tmp = sArr(i, 1) & "-" & sArr(i, 3)
    If Not Dic.Exists(Tmp) Then
        k = k + 1: Dic.Add Tmp, k: reArr(k, 1) = k
        For j = 1 To UBound(sArr, 2)
            reArr(k, j + 1) = sArr(i, j)
        Next j
    Else
        For j = 4 To UBound(sArr, 2)
            reArr(Dic.Item(Tmp), j + 1) = _
                IIf(sArr(i, j) = "", reArr(Dic.Item(Tmp), j + 1), _
                    IIf((reArr(Dic.Item(Tmp), j + 1) = "" Or _
                        reArr(Dic.Item(Tmp), j + 1) = sArr(i, j)), sArr(i, j), _
                        reArr(Dic.Item(Tmp), j + 1) & Chr(10) & sArr(i, j)))
        Next j
    End If
Next i
If k Then
    Sheets("GPE").range("A4").Resize(k, UBound(sArr, 2) + 1) = reArr
    Sheets("GPE").range("A4").Resize(k, UBound(sArr, 2) + 1).Borders.LineStyle = 1
End If
End Sub
 

File đính kèm

DẠ CẢM ƠN BÁC NHIỀU TIỆN THỂ NHỜ BÁC CODE CHO EM FILE NÀY ĐƯỢC KHÔNG À
1/ Không được viết hoa có thể sẽ vi phạm nội quy. Viết code khó quá nên tôi làm thủ công.
2/ Tách sheet cột nào không nêu rỏ, nên tôi không làm.
 

File đính kèm

2/ Thêm phần tách sheet không nêu rỏ nên tôi dựa vào cột C để tách.
Dạ cảm ơn anh nhiều à. Anh tốt quá, Dạ nhờ anh giúp thêm cột g (lmax, với điều kiện: từ 15 trở lên; từ 12 đến dưới 15 và dưới 12), cột ab (nghề chính); cột ad (vùng tuyên) và cột o (vật liệu).
 
Dạ cảm ơn anh nhiều à. Anh tốt quá, Dạ nhờ anh giúp thêm cột g (lmax, với điều kiện: từ 15 trở lên; từ 12 đến dưới 15 và dưới 12), cột ab (nghề chính); cột ad (vùng tuyên) và cột o (vật liệu).
Bạn kiểm tra code bài #22 đã đúng chưa, nó sử dụng mảng cho kết quả nhanh hơn xử lý trên Range.
 
Web KT

Bài viết mới nhất

Back
Top Bottom