Hỗ trợ Merge cell các dòng với điều kiện cho trước.

kimhoang94 · 7/4/20

Xin chào mọi người,

E có 1 file dữ liệu gồm mã Cột mã ID (A) và Cột Name sản phẩm (C), vấn đề xảy ra khi trong cùng 1 cột A xuất hiện nhiều mã ID giống nhau và với mỗi hàng thì có tên sản phẩm khác nhau, nên rất mong mọi người có thể hỗ trợ giúp e 1 đoạn code nào có thể tự động merge các sản phẩm của cột C theo điều kiện là các mã giống nhau của cột A được không ạ. Em xin đính kèm hình minh họa và file dữ liệu.

Em gửi kèm là hình ảnh sau khi e ngồi merge tay lại rồi ạ:

Rất mong mn có thể giúp đỡ, do số lượng hàng lên đến gần 1000 dòng nên merge xong là e rụng rời luôn.
File e đính kèm có phân nửa thôi ạ, e đã merge hết phân nửa ùi.

Hoàng Trọng Nghĩa · 8/4/20

kimhoang94 đã viết:
Xin chào mọi người,

E có 1 file dữ liệu gồm mã Cột mã ID (A) và Cột Name sản phẩm (C), vấn đề xảy ra khi trong cùng 1 cột A xuất hiện nhiều mã ID giống nhau và với mỗi hàng thì có tên sản phẩm khác nhau, nên rất mong mọi người có thể hỗ trợ giúp e 1 đoạn code nào có thể tự động merge các sản phẩm của cột C theo điều kiện là các mã giống nhau của cột A được không ạ. Em xin đính kèm hình minh họa và file dữ liệu.
View attachment 235024

Em gửi kèm là hình ảnh sau khi e ngồi merge tay lại rồi ạ:

View attachment 235025
Rất mong mn có thể giúp đỡ, do số lượng hàng lên đến gần 1000 dòng nên merge xong là e rụng rời luôn.
File e đính kèm có phân nửa thôi ạ, e đã merge hết phân nửa ùi.

1) Chúng ta có thể sort cột A trước (mục đích để tập hợp các ID giống nhau) rồi mới tính tới merge được không bạn?
2) Trường hợp đã có vùng merge sẵn thì sao?

PacificPR · 8/4/20

kimhoang94 đã viết:
Xin chào mọi người,

E có 1 file dữ liệu gồm mã Cột mã ID (A) và Cột Name sản phẩm (C), vấn đề xảy ra khi trong cùng 1 cột A xuất hiện nhiều mã ID giống nhau và với mỗi hàng thì có tên sản phẩm khác nhau, nên rất mong mọi người có thể hỗ trợ giúp e 1 đoạn code nào có thể tự động merge các sản phẩm của cột C theo điều kiện là các mã giống nhau của cột A được không ạ. Em xin đính kèm hình minh họa và file dữ liệu.
View attachment 235024

Em gửi kèm là hình ảnh sau khi e ngồi merge tay lại rồi ạ:

View attachment 235025
Rất mong mn có thể giúp đỡ, do số lượng hàng lên đến gần 1000 dòng nên merge xong là e rụng rời luôn.
File e đính kèm có phân nửa thôi ạ, e đã merge hết phân nửa ùi.

Bạn thử đoạn Code này xem sao

PHP:

Sub Merge_cell()
    Dim Dic As Object, sKey As String
    Dim sArr(), dArr(), I As Long, J As Long, K As Long
    Dim R As Long, C As Long, Cskey As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Query result")
    sArr = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value
    R = UBound(sArr, 1): C = UBound(sArr, 2): Cskey = 1
    ReDim dArr(1 To R, 1 To C)
    For I = 1 To R
        sKey = sArr(I, Cskey)
        If Not Dic.Exists(sKey) Then
            K = K + 1
            Dic.Add sKey, K
            For J = 1 To C
                 dArr(K, J) = "'" & sArr(I, J)
            Next J
        Else
            For J = 1 To C
                If J = Cskey Then GoTo Tiep Else dArr(Dic.Item(sKey), J) = _
                        dArr(Dic.Item(sKey), J) & Chr(10) & sArr(I, J)
Tiep:
            Next J
        End If
    Next I
    With Range("I2")
        .Resize(10000, C).Clear
        .Resize(K, C) = dArr
        .Resize(K, C).Borders.LineStyle = 1
    End With
End With
Set Dic = Nothing
End Sub

be_09 · 8/4/20

kimhoang94 đã viết:
Xin chào mọi người,

E có 1 file dữ liệu gồm mã Cột mã ID (A) và Cột Name sản phẩm (C), vấn đề xảy ra khi trong cùng 1 cột A xuất hiện nhiều mã ID giống nhau và với mỗi hàng thì có tên sản phẩm khác nhau, nên rất mong mọi người có thể hỗ trợ giúp e 1 đoạn code nào có thể tự động merge các sản phẩm của cột C theo điều kiện là các mã giống nhau của cột A được không ạ. Em xin đính kèm hình minh họa và file dữ liệu.

Em gửi kèm là hình ảnh sau khi e ngồi merge tay lại rồi ạ:
Rất mong mn có thể giúp đỡ, do số lượng hàng lên đến gần 1000 dòng nên merge xong là e rụng rời luôn.
File e đính kèm có phân nửa thôi ạ, e đã merge hết phân nửa ùi.

Tôi sửa code bài 3 của PacificPR và lấy dữ liệu sang sheet Ket_Quả để thực hiện việc gộp dữ liệu.
Thực hiện như sau: Copy dữ liệu cần gộp vào sheet Query result, sang sheet Ket_Quả nhấn nút ta sẽ được kết quả gộp như hình.

kimhoang94 · 8/4/20

Hoàng Trọng Nghĩa đã viết:
1) Chúng ta có thể sort cột A trước (mục đích để tập hợp các ID giống nhau) rồi mới tính tới merge được không bạn?
2) Trường hợp đã có vùng merge sẵn thì sao?

dạ e có filter cột A trc để dồn các số giống nhau lại ak, mà lúc gửi file thì e gửi nhầm file raw T.T

Bài đã được tự động gộp: 8/4/20

PacificPR đã viết:

Bạn thử đoạn Code này xem sao

PHP:

Sub Merge_cell()
    Dim Dic As Object, sKey As String
    Dim sArr(), dArr(), I As Long, J As Long, K As Long
    Dim R As Long, C As Long, Cskey As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Query result")
    sArr = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value
    R = UBound(sArr, 1): C = UBound(sArr, 2): Cskey = 1
    ReDim dArr(1 To R, 1 To C)
    For I = 1 To R
        sKey = sArr(I, Cskey)
        If Not Dic.Exists(sKey) Then
            K = K + 1
            Dic.Add sKey, K
            For J = 1 To C
                 dArr(K, J) = "'" & sArr(I, J)
            Next J
        Else
            For J = 1 To C
                If J = Cskey Then GoTo Tiep Else dArr(Dic.Item(sKey), J) = _
                        dArr(Dic.Item(sKey), J) & Chr(10) & sArr(I, J)
Tiep:
            Next J
        End If
    Next I
    With Range("I2")
        .Resize(10000, C).Clear
        .Resize(K, C) = dArr
        .Resize(K, C).Borders.LineStyle = 1
    End With
End With
Set Dic = Nothing
End Sub

em cảm ơn PacificPR nhiều lắm ạ.

Bài đã được tự động gộp: 8/4/20

be09 đã viết:
Tôi sửa code bài 3 của PacificPR và lấy dữ liệu sang sheet Ket_Quả để thực hiện việc gộp dữ liệu.
Thực hiện như sau: Copy dữ liệu cần gộp vào sheet Query result, sang sheet Ket_Quả nhấn nút ta sẽ được kết quả gộp như hình.

View attachment 235036

dạ e cảm ơn be09 nhiều , e đã thử và thành công ngoài mong đợi luôn, cảm ơn mn nhiều. <3 <3 <3

HieuCD · 8/4/20

PacificPR đã viết:

Bạn thử đoạn Code này xem sao

PHP:

Sub Merge_cell()
    Dim Dic As Object, sKey As String
    Dim sArr(), dArr(), I As Long, J As Long, K As Long
    Dim R As Long, C As Long, Cskey As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Query result")
    sArr = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value
    R = UBound(sArr, 1): C = UBound(sArr, 2): Cskey = 1
    ReDim dArr(1 To R, 1 To C)
    For I = 1 To R
        sKey = sArr(I, Cskey)
        If Not Dic.Exists(sKey) Then
            K = K + 1
            Dic.Add sKey, K
            For J = 1 To C
                 dArr(K, J) = "'" & sArr(I, J)
            Next J
        Else
            For J = 1 To C
                If J = Cskey Then GoTo Tiep Else dArr(Dic.Item(sKey), J) = _
                        dArr(Dic.Item(sKey), J) & Chr(10) & sArr(I, J)
Tiep:
            Next J
        End If
    Next I
    With Range("I2")
        .Resize(10000, C).Clear
        .Resize(K, C) = dArr
        .Resize(K, C).Borders.LineStyle = 1
    End With
End With
Set Dic = Nothing
End Sub

Không dùng Dic được không

Hoàng Trọng Nghĩa · 8/4/20

HieuCD đã viết:
Không dùng Dic được không

Được chứ, thậm chí dùng combobox để giải quyết vấn đề này cũng OK luôn!

HieuCD · 8/4/20

Hoàng Trọng Nghĩa đã viết:
Được chứ, thậm chí dùng combobox để giải quyết vấn đề này cũng OK luôn!

Không hình dung được cách dùng combobox, bạn viết lệnh cho mình và anh em học hỏi /-*+/

Hoàng Trọng Nghĩa · 8/4/20

HieuCD đã viết:
Không hình dung được cách dùng combobox, bạn viết lệnh cho mình và anh em học hỏi

Với dạng gộp dữ liệu này, chúng ta có thể dùng Dictionary cũng được, Collection cũng được, xử lý trên Array hay Range cũng được, nhưng tôi sẽ giới thiệu cho các bạn một phương pháp mới, đó là sử dụng ComboBox để làm việc này, rất dễ hiểu để thực hiện.

Các bạn cần phải tạo một ComboBox trên UserForm (nên) hoặc trên Sheet để thực hiện nhé!

Đây là code của thủ tục này:

Mã:

Sub GopDuLieu()
    Dim arrNguon
    Dim c As Byte
    Dim cbxGopDuLieu As MSForms.ComboBox
    Dim e As Long, n As Long, r As Long, u As Long
    
    e = Sheets("Query result").Range("A" & Rows.Count).End(xlUp).Row
    arrNguon = Sheets("Query result").Range("A2:F" & e).Value
    
    u = UBound(arrNguon, 1)
    
    Set cbxGopDuLieu = UserForm1.ComboBox1
    cbxGopDuLieu.Clear
    With cbxGopDuLieu
        For r = 1 To u
            .Text = arrNguon(r, 1)
            If Not .MatchFound Then
                .AddItem arrNguon(r, 1), n
                For c = 1 To 5
                    .List(n, c) = "'" & arrNguon(r, c + 1)
                Next
                n = n + 1
            Else
                For c = 1 To 5
                    .List(.ListIndex, c) = .List(.ListIndex, c) & vbLf & arrNguon(r, c + 1)
                Next
            End If
        Next
        r = .ListCount + 1
    End With
    
    Sheets("KQ_ComboBox").Range("A2:F" & Rows.Count).Clear
    With Sheets("KQ_ComboBox").Range("A2:F" & r)
        .Value = cbxGopDuLieu.List
        .Borders.LineStyle = 1
        .VerticalAlignment = xlTop
        .WrapText = True
    End With
End Sub

Hỗ trợ Merge cell các dòng với điều kiện cho trước.

kimhoang94

Thành viên mới

File đính kèm

Hoàng Trọng Nghĩa

Chuyên gia GPE

PacificPR

Thành viên mới

be_09

Biên Hòa, Đồng Nai

File đính kèm

kimhoang94

Thành viên mới

HieuCD

Chuyên gia GPE

Hoàng Trọng Nghĩa

Chuyên gia GPE

HieuCD

Chuyên gia GPE

Hoàng Trọng Nghĩa

Chuyên gia GPE

File đính kèm

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

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian