[VBA] Cộng 2 chuỗi trong 2 cell vào 1 cell và xóa dòng ??? (1 người xem)

[thanlong_1189]

Em chào cả nhà !
Em có vấn đề này mong được giúp đỡ: Em có 1 file với các dòng như sau:

dòng 9 và 10 thì có cột thứ 2 có giá trị giống nhau đấy ah, bây giờ em muốn sau khi chạy VBA (khi mở file lên thì VBA sẽ tự động chạy ý ah) thì kết quả sẽ như sau:

Mong mọi người giúp đỡ ah ! Em cảm ơn !

 

[leonguyenz]

Em chào cả nhà !
Em có vấn đề này mong được giúp đỡ: Em có 1 file với các dòng như sau:
View attachment 123038
dòng 9 và 10 thì có cột thứ 2 có giá trị giống nhau đấy ah, bây giờ em muốn sau khi chạy VBA (khi mở file lên thì VBA sẽ tự động chạy ý ah) thì kết quả sẽ như sau:
View attachment 123040
Mong mọi người giúp đỡ ah ! Em cảm ơn !

Thay vì bạn print screen lại thì đưa file lên có phải nhanh hơn không?
Có dữ liệu thật thì tiện hơn.

 

[thanlong_1189]

File đây bác ơi !
Hiện tại:
- Mỗi ItemCode sẽ có 1 hoặc nhiều hoặc không có sản phẩm khuyến mại nào
- Có điều các SP KM lại nằm ở 2 dòng và ItemCode cũng hiển thị 2 lần ở 2 dòng
Em muốn:
- Mỗi ItemCode sẽ có 1 hoặc nhiều hoặc không có sản phẩm khuyến mại nào
- Nhưng ItemCode chỉ xuất hiện 1 lần và SP KM sẽ nằm cùng 1 dòng và cách nhau bằng 1 ký tự nào đó (vd: SP KM1, SP KM2 hoặc SP KM1; SP KM2....)
Em cảm ơn !

 

[leonguyenz]

File đây bác ơi !
Hiện tại:
- Mỗi ItemCode sẽ có 1 hoặc nhiều hoặc không có sản phẩm khuyến mại nào
- Có điều các SP KM lại nằm ở 2 dòng và ItemCode cũng hiển thị 2 lần ở 2 dòng
Em muốn:
- Mỗi ItemCode sẽ có 1 hoặc nhiều hoặc không có sản phẩm khuyến mại nào
- Nhưng ItemCode chỉ xuất hiện 1 lần và SP KM sẽ nằm cùng 1 dòng và cách nhau bằng 1 ký tự nào đó (vd: SP KM1, SP KM2 hoặc SP KM1; SP KM2....)
Em cảm ơn !

Bạn chạy code sau:
[gpecode=vb]
Sub DupDel()
Dim Rng As Range, i As Long, Dic As Object, k As Long
Dim iCode As String, Km As String
Application.ScreenUpdating = False
Set Rng = Sheet1.Range("D10:Z" & Sheet1.Range("D65535").End(xlUp).Row)
Set Dic = CreateObject("Scripting.Dictionary")
For i = Rng.Rows.Count To 1 Step -1
iCode = Rng(i, 1).Value
Km = Rng(i, 20).Value
If Not Dic.Exists(iCode) Then
k = k + 1
Dic.Add iCode, k
Else
Rng(Dic.Item(iCode), 20) = IIf(Len(Km), Km & ", ", "") & Rng(Dic.Item(iCode), 20)
Rng(i, 1) = Empty
End If
Next i
Rng.Resize(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Set Dic = Nothing
Application.ScreenUpdating = True
End Sub
[/gpecode]
Mở Marco lên nhé.

 

[thanlong_1189]

Được rồi, đúng ý luôn
Cảm ơn bạn @leonguyenz nhiều nhé