Dùng cột phụ, xem công thức trong fileDear mọi người,
Em đang có vấn đề là muốn nối chuỗi các dòng khác nhau, data như sau:
View attachment 297178
Nhờ các anh/chị xem qua, cho em keyword để research hoặc cách giải vấn đề này bằng VBA.
Em xin cám ơn anh/chị.
Góp vui , bạn có thể tham khảo đoạn code VBA củ chuối dưới đâycách giải vấn đề này bằng VBA.
Option Explicit
Sub Gopvui()
Dim i&, j&, Lr&, t&, k&
Dim Arr(), KQ(), D, S
On Error Resume Next
With Sheet1
Lr = .Cells(1000000, 3).End(xlUp).Row
Arr = .Range("A2:C" & Lr).Value
For i = 1 To UBound(Arr)
If Arr(i, 1) <> Empty Then If D = Empty Then D = i Else D = D & "," & i
Next i
S = Split(D, ",")
ReDim KQ(1 To UBound(S) + 1, 1 To 3)
For j = 0 To UBound(S)
t = t + 1
KQ(t, 1) = Arr(S(j), 1)
For k = S(j) To S(j + 1) - 1
If Arr(k, 2) <> Empty Then If KQ(t, 2) = Empty Then KQ(t, 2) = Arr(k, 2) Else KQ(t, 2) = KQ(t, 2) & ", " & Arr(k, 2)
If Arr(k, 3) <> Empty Then If KQ(t, 3) = Empty Then KQ(t, 3) = Arr(k, 3) Else KQ(t, 3) = KQ(t, 3) & ", " & Arr(k, 3)
Next k
Next j
.Range("G7").Resize(t, 3) = KQ
End With
End Sub
1. Bạn dùng UNIQUE lọc lấy mã khách hàng duy nhất (nếu bạn dùng office 365 hoặc 2021, nếu bạn không dùng office này thì có thể search lọc duy nhất để lấy mã khách hàng)Dear mọi người,
Em đang có vấn đề là muốn nối chuỗi các dòng khác nhau, data như sau:
View attachment 297178
Nhờ các anh/chị xem qua, cho em keyword để research hoặc cách giải vấn đề này bằng VBA.
Em xin cám ơn anh/chị.
Em cám ơn anh @hoangminhtien nhiều nha.1. Bạn dùng UNIQUE lọc lấy mã khách hàng duy nhất (nếu bạn dùng office 365 hoặc 2021, nếu bạn không dùng office này thì có thể search lọc duy nhất để lấy mã khách hàng)
2. Sau khi lọc được mã khách hàng, bạn dùng TEXTJOIN để nối các chuỗi tương ứng như trong file (TEXTJOIN có từ office 2019).
Em cám ơn anh @HUONGHCKT nhiều nha.Góp vui , bạn có thể tham khảo đoạn code VBA củ chuối dưới đây
Mã:Option Explicit Sub Gopvui() Dim i&, j&, Lr&, t&, k& Dim Arr(), KQ(), D, S On Error Resume Next With Sheet1 Lr = .Cells(1000000, 3).End(xlUp).Row Arr = .Range("A2:C" & Lr).Value For i = 1 To UBound(Arr) If Arr(i, 1) <> Empty Then If D = Empty Then D = i Else D = D & "," & i Next i S = Split(D, ",") ReDim KQ(1 To UBound(S) + 1, 1 To 3) For j = 0 To UBound(S) t = t + 1 KQ(t, 1) = Arr(S(j), 1) For k = S(j) To S(j + 1) - 1 If Arr(k, 2) <> Empty Then If KQ(t, 2) = Empty Then KQ(t, 2) = Arr(k, 2) Else KQ(t, 2) = KQ(t, 2) & ", " & Arr(k, 2) If Arr(k, 3) <> Empty Then If KQ(t, 3) = Empty Then KQ(t, 3) = Arr(k, 3) Else KQ(t, 3) = KQ(t, 3) & ", " & Arr(k, 3) Next k Next j .Range("G7").Resize(t, 3) = KQ End With End Sub