VBA7讲课后练习2: 除去重复值并添加空值

兰色幻想

<p> o13uZthp.rar (4.45 KB, 下载次数: 93)

2008-1-5 16:00 上传

点击文件名下载附件
VBA7讲课后练习2: 除去重复值并添加空值 <br/></p><p><font color="#e70808">补充一个知识点":</font></p><p>&nbsp; 符合条件时跳出循环: </p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;For x=1 to 100 </p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; if&nbsp; 条件成立 then</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; goto&nbsp; 100&nbsp;&nbsp;&nbsp; '<font color="#2907b5">或 Exit For</font> </p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;end if </p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;............</p><p>&nbsp;&nbsp;&nbsp;&nbsp; Next&nbsp; x</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;100:&nbsp; </p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 其他语句</p><p><font color="#1111ee">做完后把代码跟贴传上来</font></p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</p>

[此贴子已经被作者于2008-1-5 16:05:24编辑过]

pp8597

<p>练习一下！</p>

GB16888

下载先

laosanjie

下载练习了。谢谢兰版主！！！

晓

Sub 填充() '0.0078125秒<br/>t = Timer<br/>Range("b:b") = ""<br/>Dim i, j As Integer<br/>Dim arr, arr1(), k, x As Integer<br/>x = Range("a65536").End(xlUp).Row<br/>k = 1<br/>arr = Range("a1:a" &amp; x)<br/>ReDim arr1(1 To x, 1 To 1)<br/>For i = 1 To x<br/>&nbsp; If arr(i, 1) &lt;&gt; "" Then<br/>&nbsp;&nbsp;&nbsp; For j = 1 To k<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If arr(i, 1) = arr1(j, 1) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GoTo 100<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp; arr1(k, 1) = arr(i, 1)<br/>&nbsp;&nbsp;&nbsp; k = k + 2<br/>&nbsp; End If<br/>100:<br/>&nbsp; Next i<br/>Range("b2").Resize(k, 1) = arr1<br/>MsgBox Timer - t<br/>End Sub

[此贴子已经被作者于2008-1-6 15:18:05编辑过]

hhzjxss

<p>我来了，试试看！</p>

jianzh

Sub 填充()<br/>t = Timer<br/>Range("C2:C65536").ClearContents<br/>Dim arr, arr1<br/>Dim x As Integer, y As Integer, k As Integer, mrow As Integer<br/>mrow = Range("a65536").End(xlUp).Row<br/>ReDim arr(1 To mrow, 1 To 1), arr1(1 To mrow * 2, 1 To 1)<br/>arr = Range("A1:A" &amp; mrow)<br/>arr1(1, 1) = arr(1, 1)<br/>k = 1<br/>For x = 2 To mrow<br/>&nbsp; If arr(x, 1) &lt;&gt; "" Then<br/>&nbsp;&nbsp;&nbsp; For y = 1 To mrow * 2<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If arr(x, 1) = arr1(y, 1) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GoTo 100<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Next y<br/>&nbsp;&nbsp;&nbsp; k = k + 2<br/>&nbsp;&nbsp;&nbsp; arr1(k, 1) = arr(x, 1)<br/>&nbsp; End If<br/>100:<br/>Next x<br/>Range("C2").Resize(mrow * 2, 1) = arr1<br/>MsgBox Timer - t<br/>End Sub

zhangyilike

<p>我这个运行结果往下错了一行，怎么调呢？[em04][em04]</p><p>Sub 练习()<br/>Dim arr, arr1, x As Integer, y As Integer, k As Integer<br/>arr = Range("a1").Resize(Range("a65536").End(xlUp).Row, 1)<br/>ReDim arr1(1 To UBound(arr), 1 To 1)<br/>For x = 1 To UBound(arr)<br/>&nbsp; If arr(x, 1) &lt;&gt; "" Then<br/>&nbsp;&nbsp;&nbsp; For y = 1 To UBound(arr)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If arr(x, 1) = arr1(y, 1) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GoTo 100<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Next y<br/>&nbsp;&nbsp;&nbsp; k = k + 2<br/>&nbsp;&nbsp;&nbsp; arr1(k, 1) = arr(x, 1)<br/>&nbsp; End If<br/>100:<br/>Next x<br/>Range("C2").Resize(Range("a65536").End(xlUp).Row, 1) = arr1</p><p>End Sub</p>

hhzjxss

Sub 获得不重复值() '雨中漫步<br/>&nbsp;&nbsp;&nbsp; Dim arr, arr1(), arr2(), arr3()<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; '先清空<br/>&nbsp;&nbsp;&nbsp; Range(Range("C2"), Range("C" &amp; Range("C65536").End(xlUp).Row + 1)).ClearContents<br/>&nbsp;&nbsp;&nbsp; k = 1<br/>&nbsp;&nbsp;&nbsp; x = Range("a65536").End(xlUp).Row<br/>&nbsp;&nbsp;&nbsp; arr = Range("A1:B" &amp; x)<br/>&nbsp;&nbsp;&nbsp; ReDim arr1(1 To UBound(arr), 1 To 1)<br/>&nbsp;&nbsp;&nbsp; ReDim arr2(1 To UBound(arr), 1 To 1)<br/>&nbsp;&nbsp;&nbsp; ReDim arr3(1 To UBound(arr), 1 To 1)<br/>&nbsp;&nbsp;&nbsp; For i = 1 To x<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If arr(i, 1) &lt;&gt; "" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For j = 1 To k<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If arr(i, 1) = arr1(j, 1) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit For<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ElseIf j = k Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; arr1(k, 1) = arr(i, 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; k = k +&nbsp;2<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next j<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Next i<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Sheet1.Range("c2").Resize(k, 1) = arr1<br/>End Sub<br/>

[此贴子已经被作者于2008-1-5 22:15:33编辑过]

hhzjxss

<div class="msgheader">QUOTE:</div><div class="msgborder"><b>以下是引用<i>zhangyilike</i>在2008-1-5 21:40:00的发言：</b><br/><p>我这个运行结果往下错了一行，怎么调呢？[em04][em04]</p><p>Sub 练习()<br/>Dim arr, arr1, x As Integer, y As Integer, k As Integer<br/>arr = Range("a1").Resize(Range("a65536").End(xlUp).Row, 1)<br/>ReDim arr1(1 To UBound(arr), 1 To 1)<br/>For x = 1 To UBound(arr)<br/>&nbsp; If arr(x, 1) &lt;&gt; "" Then<br/>&nbsp;&nbsp;&nbsp; For y = 1 To UBound(arr)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If arr(x, 1) = arr1(y, 1) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GoTo 100<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Next y<br/>&nbsp;&nbsp;&nbsp; k = k + 2<br/>&nbsp;&nbsp;&nbsp; arr1(k, 1) = arr(x, 1)<br/>&nbsp; End If<br/>100:<br/>Next x<br/>Range("C2").Resize(Range("a65536").End(xlUp).Row, 1) = arr1</p><p>End Sub</p></div><p></p>Dim arr, arr1, x As Integer, y As Integer, k As Integer<br/><font color="#ee3d11" size="4">k = -1</font><br/>arr = Range("a1").Resize(Range("a65536").End(xlUp).Row, 1)<br/>