(help) nối chuỗi có điều kiện

[pearlymy]

Em có file trăn trở mấy ngày này mà chưa tìm được đáp án
Mong mọi người giúp đỡ. Em cám ơn rất nhiều

SẢN PHẨM	ĐƠN GIA	SỐ LƯỢNG	SERI
THẺ XANH	200	4	X100-200
THẺ ĐỎ	100	3	D20-43
THẺ VÀNG	190	5	V20-34
THẺ XANH	210	5	X204-209
THẺ XANH	200	4	X300-301
THẺ ĐỎ	110	3	D40-50

đây là file tồn kho, khi hach toán vào chương trình kế toán, em cần diễn giải rút gọn theo từng sản phẩm

Đại khái, nó sẽ ra kết quả như vầy:
THẺ XANH, SERI: X100-200 (4 * 200 VND), X204 -209 (5 * 210 VND), X300-301 (4 * 200 VND), THẺ VÀNG SERI: V20-40 (5 * 190 VND), THẺ ĐỎ SERI: D20-43 (3*100 VND), D40-50 (3 * 110 VND)

Em xin chân thành cám ơn 1 lần nữa!

 

[HieuCD]

dùng cột phụ để tính

 

[huuthang_bd]

Em có file trăn trở mấy ngày này mà chưa tìm được đáp án
Mong mọi người giúp đỡ. Em cám ơn rất nhiều

SẢN PHẨM	ĐƠN GIA	SỐ LƯỢNG	SERI
THẺ XANH	200	4	X100-200
THẺ ĐỎ	100	3	D20-43
THẺ VÀNG	190	5	V20-34
THẺ XANH	210	5	X204-209
THẺ XANH	200	4	X300-301
THẺ ĐỎ	110	3	D40-50

đây là file tồn kho, khi hach toán vào chương trình kế toán, em cần diễn giải rút gọn theo từng sản phẩm

Đại khái, nó sẽ ra kết quả như vầy:
THẺ XANH, SERI: X100-200 (4 * 200 VND), X204 -209 (5 * 210 VND), X300-301 (4 * 200 VND), THẺ VÀNG SERI: V20-40 (5 * 190 VND), THẺ ĐỎ SERI: D20-43 (3*100 VND), D40-50 (3 * 110 VND)

Em xin chân thành cám ơn 1 lần nữa!

Dùng UDF cho nó tiện

Function NoiDung(Arr) As String
Dim i As Long
Arr = Arr
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Arr, 1)
        If Not .Exists(Arr(i, 1)) Then
            .Add Arr(i, 1), Arr(i, 1) & ", SERI: " & Arr(i, 4) & " (" & Arr(i, 3) & " * " & Arr(i, 2) & " VND)"
        Else
            .Item(Arr(i, 1)) = .Item(Arr(i, 1)) & ", " & Arr(i, 4) & " (" & Arr(i, 3) & " * " & Arr(i, 2) & " VND)"
        End If
    Next
    NoiDung = Join(.Items, "; ")
End With
End Function

 

[pearlymy]

Dùng UDF cho nó tiện

Function NoiDung(Arr) As String
Dim i As Long
Arr = Arr
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Arr, 1)
        If Not .Exists(Arr(i, 1)) Then
            .Add Arr(i, 1), Arr(i, 1) & ", SERI: " & Arr(i, 4) & " (" & Arr(i, 3) & " * " & Arr(i, 2) & " VND)"
        Else
            .Item(Arr(i, 1)) = .Item(Arr(i, 1)) & ", " & Arr(i, 4) & " (" & Arr(i, 3) & " * " & Arr(i, 2) & " VND)"
        End If
    Next
    NoiDung = Join(.Items, "; ")
End With
End Function

hay quá, cám ơn anh rất nhiều
VBA thiệt phi thường, em đang bập bõm học video trên youtube, không biết chừng nào mới giải quyết được mấy cái đơn giản vầy, chứ được như các anh chị ở đây chắc không dám mong gì