|
Sub 去除单元格重复内容()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
On Error Resume Next
Set qy = Application.InputBox("", "请选择样本区域", , , , , , 8)
zhs = qy.Rows.Count
If qy Is Nothing Then GoTo 101
Set jgqy = Application.InputBox("", "请选择结果摆放起始位置", , , , , , 8)
jgqyh = jgqy.Row
jgqyl = jgqy.Column
If jgqy Is Nothing Then GoTo 101
cff = Application.InputBox("请输入拆分符号")
hbf = Application.InputBox("请输入合并符号")
arr = qy
If zhs = 1 Then GoTo 8
For Each Rng In arr
arr1 = VBA.Split(Rng, cff)
For Each rngs In arr1
d(rngs) = ""
Next
i = VBA.Join(d.keys, hbf)
n = n + 1
Cells(jgqyh - 1 + n, jgqyl) = i
d.RemoveAll
Next
GoTo 101
8:
arr1 = VBA.Split(arr, cff)
For Each rngs In arr1
d(rngs) = ""
Next
i = VBA.Join(d.keys, hbf)
n = n + 1
Cells(jgqyh - 1 + n, jgqyl) = i
d.RemoveAll
101:
End Sub
|
|