Cam ơn Ba tê nhiều. Ba tê có thể giaải thích qa về code đươc ko ạ.
Ấn Alt+F11 sẽ thấy cái này và bạn tự nghiên cứu, còn giải thích thì "hổng nỗi".
[GPECODE=vb]Public Sub GPE()
Dim Dic As Object, Tem As Variant, I As Long, J As Long, K As Long
Dim Text1 As String, Text2 As String, Str As String, sArr(), dArr()
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Lich")
Text1 = .[F1].Value
Text2 = .[F2].Value
sArr = .Range(.[B4], .[B4].End(xlDown)).Resize(, 3).Value
ReDim dArr(1 To UBound(sArr, 1) * 2, 1 To 2)
End With
For I = 1 To UBound(sArr, 1)
For J = 2 To 3
Str = IIf(J = 2, Text1, Text2)
If sArr(I, J) <> Empty Then
Tem = sArr(I, J)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = Tem
dArr(K, 2) = Str & sArr(I, 1)
Else
dArr(Dic.Item(Tem), 2) = dArr(Dic.Item(Tem), 2) & ", " & Str & sArr(I, 1)
End If
End If
Next J
Next I
Application.ScreenUpdating = False
With Sheets("CV_NGAY")
.[A3:B1000].ClearContents
.[A3:B1000].Borders.LineStyle = xlNone
If K Then
.[A3].Resize(K, 2) = dArr
.[A3].Resize(K, 2).Sort Key1:=.[A3]
.[A3].Resize(K, 2).Borders.LineStyle = xlContinuous
End If
End With
Application.ScreenUpdating = True
Set Dic = Nothing
End Sub[/GPECODE]
