[已解决]求助:用V代码如何提取不重复的姓名

fjmxwrs

如题,如何写提取不重复姓名的代码?要求在附件中,请老师同学们指点.谢谢

03rdfMF1.rar (1.71 KB, 下载次数: 17)

2010-10-22 20:03 上传

点击文件名下载附件
求助:用V代码如何提取不重复的姓名

最佳答案

月排行榜 / 总排行榜

liuguansky

2010-10-22 20:29

1. Sub justtest()<br/>&nbsp;&nbsp;&nbsp; Dim dic, arr, i&amp;, j&amp;<br/>&nbsp;&nbsp;&nbsp; Set dic = CreateObject("scripting.dictionary")<br/>&nbsp;&nbsp;&nbsp; arr = Range("A2").CurrentRegion.Value<br/>&nbsp;&nbsp;&nbsp; For i = 2 To UBound(arr, 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For j = 1 To UBound(arr, 2) - 1 Step 2<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If arr(i, j) &lt;&gt; "" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If dic.exists(arr(i, j)) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; dic(arr(i, j)) = dic(arr(i, j)) + arr(i, j + 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else: dic.Add arr(i, j), arr(i, j + 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Next j, i<br/>&nbsp;&nbsp;&nbsp; Range("f2:g" &amp; Rows.Count).ClearContents<br/>&nbsp;&nbsp;&nbsp; If dic.Count &gt; 0 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(2, "f").Resize(dic.Count, 1) = Application.Transpose(dic.keys)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(2, "g").Resize(dic.Count, 1) = Application.Transpose(dic.items)<br/>&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Set dic = Nothing<br/>End Sub

复制代码

字典的强项.

f7OH02hS.rar (9.28 KB, 下载次数: 71)

2010-10-22 20:29 上传

点击文件名下载附件
求助:用V代码如何提取不重复的姓名

跳转到最佳答案楼层

unsamesky

如果数据不多，就不需要用数组和字典了！！请测试： eYC1EmR0.rar (9.21 KB, 下载次数: 6)

2010-10-22 20:29 上传

点击文件名下载附件

[此贴子已经被作者于2010-10-22 20:29:22编辑过]

liuguansky

1. Sub justtest()<br/>&nbsp;&nbsp;&nbsp; Dim dic, arr, i&amp;, j&amp;<br/>&nbsp;&nbsp;&nbsp; Set dic = CreateObject("scripting.dictionary")<br/>&nbsp;&nbsp;&nbsp; arr = Range("A2").CurrentRegion.Value<br/>&nbsp;&nbsp;&nbsp; For i = 2 To UBound(arr, 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For j = 1 To UBound(arr, 2) - 1 Step 2<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If arr(i, j) &lt;&gt; "" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If dic.exists(arr(i, j)) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; dic(arr(i, j)) = dic(arr(i, j)) + arr(i, j + 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else: dic.Add arr(i, j), arr(i, j + 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Next j, i<br/>&nbsp;&nbsp;&nbsp; Range("f2:g" &amp; Rows.Count).ClearContents<br/>&nbsp;&nbsp;&nbsp; If dic.Count &gt; 0 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(2, "f").Resize(dic.Count, 1) = Application.Transpose(dic.keys)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(2, "g").Resize(dic.Count, 1) = Application.Transpose(dic.items)<br/>&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Set dic = Nothing<br/>End Sub

复制代码

字典的强项.

f7OH02hS.rar (9.28 KB, 下载次数: 71)

2010-10-22 20:29 上传

点击文件名下载附件
求助:用V代码如何提取不重复的姓名

fjmxwrs

感谢两位老师,都可以实现,但3楼的速度快了很多,感谢了.还不是很理解,学习中

搁浅2008

3楼代码 有部分不必要的代码

搁浅2008

Sub aa()
    Dim d As Object
    Dim arr
    Dim i As Long
    Dim j As Long
    Set d = CreateObject("scripting.dictionary")
    arr = Range("A2").CurrentRegion.Value
    For i = 2 To UBound(arr, 1)
        For j = 1 To 4 Step 2
            If arr(i, j) <> "" Then
                d(arr(i, j)) = d(arr(i, j)) + arr(i, j + 1)
            End If
        Next j
    Next i
    Range("F2").Resize(d.Count, 1) = Application.Transpose(d.keys)
    Range("G2").Resize(d.Count, 1) = Application.Transpose(d.items)
End Sub
字典遇到没有的会自动创建

青城山苦丁茶

就是，并且还要快些

fjmxwrs

QUOTE:

以下是引用搁浅2008在2010-10-22 20:59:00的发言：

Sub aa()
    Dim d As Object
    Dim arr
    Dim i As Long
    Dim j As Long
    Set d = CreateObject("scripting.dictionary")
    arr = Range("A2").CurrentRegion.Value
    For i = 2 To UBound(arr, 1)
        For j = 1 To 4 Step 2
            If arr(i, j) <> "" Then
                d(arr(i, j)) = d(arr(i, j)) + arr(i, j + 1)
            End If
        Next j
    Next i
    Range("F2").Resize(d.Count, 1) = Application.Transpose(d.keys)
    Range("G2").Resize(d.Count, 1) = Application.Transpose(d.items)
End Sub
字典遇到没有的会自动创建

学习,感谢老师

liuguansky

学习字典开始就要养成好的习惯。

比如用dic.exists判断存在与否

比如判断DIC.COUNT是否>0。。。。

qinhuan66

好好学习天天向上