Có thể Gộp dữ liệu từ nhiều cell lại với nhau khi sử dụng VBA không?

[Lequocvan]

Ngoài việc sử dụng hàm concatenate với tham số char(10) thì có thể dùng VBA để gộp dữ liệu từ nhiều cell lại với nhau không ah? Mong mọi người chỉ giúp ah!

 

[snow25]

View attachment 263443

Ngoài việc sử dụng hàm concatenate với tham số char(10) thì có thể dùng VBA để gộp dữ liệu từ nhiều cell lại với nhau không ah? Mong mọi người chỉ giúp ah!

Có bạn à.Nhưng không biết chỉ giúp gì à.

 

[Ba Tê]

View attachment 263443

Ngoài việc sử dụng hàm concatenate với tham số char(10) thì có thể dùng VBA để gộp dữ liệu từ nhiều cell lại với nhau không ah? Mong mọi người chỉ giúp ah!

VBA làm được với Dictionary, với điều kiện có file "giống thật" và bài viết không có các từ "ah",...

 

[Lequocvan]

Dạ, em pót file sau đây, mong các Bác chỉ giúp code VBA

 

[Lequocvan]

Tôi đã thử với code sau khi search tren Google:
Sub Test5()
'Set a reference to Microsoft Scripting Runtime by using Tools>References in the Visual Basic Editor
Dim oDict As Dictionary
Dim sData() As Variant
Dim LastRow As Long
Dim i As Long
Dim cnt As Long
Set oDict = CreateObject("Scripting.Dictionary")
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
If Not oDict.Exists(Cells(i, "A").Value) Then
cnt = cnt + 1
ReDim Preserve sData(1 To 2, 1 To cnt)
sData(1, cnt) = Cells(i, "A").Value
sData(2, cnt) = Cells(i, "B").Value
oDict.Add Cells(i, "A").Value, cnt
Else
sData(2, oDict.Item(Cells(i, "A").Value)) = sData(2, oDict.Item(Cells(i, "A").Value)) & Chr(10) & Cells(i, "B").Value
End If
Next i

Range("E2").Resize(UBound(sData, 2), 2).Value = WorksheetFunction.Transpose(sData)
End Sub
Có nhiều hơn 2 cột thì đang tìm hiểu thêm, Dictionary đúng là khó hiểu, đọc các bài trên GPE về Dictionary nhưng chưa thấm sâu.

 

[SA_DQ]

2 bước tiến hành:
(*) Giả sử dữ liệu của bạn đang ở cột 'A' & 'B' (như hình vẻ)
(a) Lập danh sách (DS) duy nhất tại 'E'
(b).1 Khai báo các tham biến cần thiết
(b).2 Tạo vòng lặp duyệt theo DS
Qua mỗi bước vòng lặp ta tìm kiếm ở cột 'A' & ghi nối dữ liệu bên phải ô tìm thấy vô ô phải liền kề ô đang duyệt

Chúc bạn thành công!

 

[concogia]

Tôi đã thử với code sau khi search tren Google:
Sub Test5()
'Set a reference to Microsoft Scripting Runtime by using Tools>References in the Visual Basic Editor
Dim oDict As Dictionary
Dim sData() As Variant
Dim LastRow As Long
Dim i As Long
Dim cnt As Long
Set oDict = CreateObject("Scripting.Dictionary")
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
If Not oDict.Exists(Cells(i, "A").Value) Then
cnt = cnt + 1
ReDim Preserve sData(1 To 2, 1 To cnt)
sData(1, cnt) = Cells(i, "A").Value
sData(2, cnt) = Cells(i, "B").Value
oDict.Add Cells(i, "A").Value, cnt
Else
sData(2, oDict.Item(Cells(i, "A").Value)) = sData(2, oDict.Item(Cells(i, "A").Value)) & Chr(10) & Cells(i, "B").Value
End If
Next i

Range("E2").Resize(UBound(sData, 2), 2).Value = WorksheetFunction.Transpose(sData)
End Sub
Có nhiều hơn 2 cột thì đang tìm hiểu thêm, Dictionary đúng là khó hiểu, đọc các bài trên GPE về Dictionary nhưng chưa thấm sâu.

Một cách dùng Dic đề phòng dữ liệu nằm lộn xộn

Public Sub Gom()
    Dim Vung, I, Kq, Dic, K, kK
    Vung = Range([A2], [A50000].End(xlUp)).Resize(, 2)
    Set Dic = CreateObject("scripting.dictionary")
    ReDim Kq(1 To UBound(Vung), 1 To 2)
        For I = 1 To UBound(Vung)
            If Not Dic.exists(Vung(I, 1)) Then
                K = K + 1
                Dic.Add Vung(I, 1), K
                Kq(K, 1) = Vung(I, 1): Kq(K, 2) = Vung(I, 2)
             Else
                kK = Dic.Item(Vung(I, 1))
                Kq(kK, 2) = Kq(kK, 2) & VBA.Chr(10) & Vung(I, 2)
             End If
        Next I
    [K2:L10000].ClearContents
    [K2].Resize(K, 2) = Kq
End Sub

Thân