Gửi bởi
thehoang7
OK<OK.
mình gửi file excell nhờ các bạn hỗ trợ
Xem file đính kèm thế nào.
( Viết thành 2 sub )
Mã:
Public Sub Phan_Chia_Tach()
Dim DL, kq(), r As Long, Tam, i
On Error Resume Next
DL = Sheet1.Range("A4").CurrentRegion
ReDim kq(1 To 10000, 1 To 2)
For r = 1 To UBound(DL)
For Each Tam In Split(DL(r, 2), ",")
i = i + 1
kq(i, 1) = DL(r, 1)
kq(i, 2) = Tam
Next Tam
Next r
Sheet1.Range("E4").Resize(i, 2).Value = kq
Sheet1.Range("E4").CurrentRegion.Columns.AutoFit
Sheet1.Range("A4").CurrentRegion.Clear
End Sub
Public Sub Ghep_Nhom()
Dim DL, kq(), r As Long, i
On Error Resume Next
DL = Sheet1.Range("E4").CurrentRegion
With CreateObject("scripting.dictionary")
For r = 1 To UBound(DL)
If Not .exists(DL(r, 1)) Then
.Add DL(r, 1), DL(r, 2)
Else
.Item(DL(r, 1)) = .Item(DL(r, 1)) & "," & DL(r, 2)
End If
Next r
ReDim kq(1 To .Count, 1 To 2)
For r = 1 To UBound(DL)
If .exists(DL(r, 1)) Then
i = i + 1
kq(i, 1) = DL(r, 1): kq(i, 2) = .Item(DL(r, 1))
.Remove DL(r, 1)
End If
Next r
End With
Sheet1.Range("A4").Resize(i, 2).Value = kq
Sheet1.Range("A4").CurrentRegion.Columns.AutoFit
Sheet1.Range("E4").CurrentRegion.Clear
End Sub
---
( Chủ thớt: Bị nhắc nhở dùng tiếng Việt rồi nha )
Trả lời kèm Trích dẫn
Thành viên tiêu biểu
