【v1-6综合练习题3】批量连接Email地址

兰色幻想

<p>&nbsp; A列为Email地址，要求每20行连接在一串，用“,”（逗号）分隔。</p><p>&nbsp; 做好后跟贴上传代码，不用上传附件。</p><p>&nbsp;</p> eIySqIv8.rar (3.93 KB, 下载次数: 129)

2007-12-16 15:17 上传

点击文件名下载附件
【v1-6综合练习题3】批量连接Email地址 <br/>

mxg825

<p><font color="#ff0000" size="7">更正了！谢谢各位提醒！</font></p><p>&nbsp;</p><p>Sub 串联邮箱()<br/>Dim i As Integer, a As Integer, MXG As String<br/>&nbsp;a = 2<br/>For i = 2 To Range("a65536").End(xlUp).Row<br/>&nbsp;&nbsp;&nbsp; If MXG = "" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MXG = Cells(i, 1)<br/>&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp; MXG = MXG &amp; "," &amp; Cells(i, 1)<br/>&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <font color="#0000ff">If i Mod 20 =&nbsp;1 Then<br/></font>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(a, 3) = MXG<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; a = a + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MXG = ""<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;Next</p><p>&nbsp;<font color="#0000ff"> Cells(a, 3) = MXG<br/></font><br/>End Sub</p><p></p>

[此贴子已经被作者于2007-12-17 10:30:14编辑过]

hhzjxss

<p>先下载，明天再做！</p><p>做了一个，传上来大家交流一下！</p><p>Dim x%, y%, z%, i%<br/>Dim rng As Range<br/>Dim cc As String<br/>Dim dd As String</p><p>Sub 合并()<br/>&nbsp;&nbsp;&nbsp; Call 清空<br/>&nbsp;&nbsp;&nbsp; x = Range("A65536").End(xlUp).Row<br/>&nbsp;&nbsp;&nbsp; For Each rng In Range("A2:A" &amp; x)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; y = (rng.Row - 2) Mod 20 + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; z = (rng.Row - 2) \ 20 + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; cc = rng.Value<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If y = 1 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(z + 1, 3) = cc<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(z + 1, 3) = Cells(z + 1, 3) &amp; "," &amp; cc<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Next rng<br/>End Sub</p><p>Sub 清空()<br/>&nbsp;&nbsp;&nbsp; x = Range("c65536").End(xlUp).Row + 1<br/>&nbsp;&nbsp;&nbsp; Range(Cells(2, 3), Cells(x, 3)).ClearContents<br/>End Sub<br/></p><p>&nbsp;</p>

[此贴子已经被作者于2007-12-16 22:58:54编辑过]

hong4777

<p>等高手的了，跟楼上一样。换了一种循环：</p><p>Sub zs()</p><p>&nbsp;Dim zs As String<br/>&nbsp; t = 2<br/>&nbsp; u = 2<br/>&nbsp; zs = Range("a2").Value<br/>&nbsp;Do<br/>&nbsp;&nbsp;&nbsp; t = t + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If (t - 2) Mod 20 &lt;&gt; 0 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; zs = zs &amp; "," &amp; Range("a" &amp; t)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else: Cells(u, 3) = zs<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; zs = Range("a" &amp; t)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; u = u + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp; Loop Until Cells(t, 1) = ""<br/>&nbsp;&nbsp; Cells(u, 3) = zs<br/>End Sub</p>

[此贴子已经被作者于2007-12-16 18:04:12编辑过]

wayy

做一下。

minant

<p>占位</p><p>我的也做完了[em01][em01][em01]</p><p>&nbsp;</p><p>Sub exercise3()<br/>Dim i%<br/>&nbsp;&nbsp;&nbsp; With Sheets(1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 2 To .Cells(65536, 1).End(xlUp).Row<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If (i - 2) Mod 20 = 0 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Cells(.Cells(65536, 3).End(xlUp).Row + 1, 3).Value = .Cells(i, 1).Value<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Cells(.Cells(65536, 3).End(xlUp).Row, 3).Value = _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Cells(.Cells(65536, 3).End(xlUp).Row, 3).Value &amp; "," &amp; .Cells(i, 1).Value<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp; End With<br/>End Sub<br/></p>

[此贴子已经被作者于2007-12-16 22:43:56编辑过]

箫风

<p>我的答案：</p><p>Sub 邮箱地址()<br/>Dim m, n As Long<br/>Dim str As String<br/>For m = 2 To Range("a65536").End(xlUp).Row<br/>&nbsp;&nbsp;&nbsp; If str = "" Then str = str &amp; Range("a" &amp; m)<br/>&nbsp;&nbsp;&nbsp; str = str &amp; "," &amp; Range("a" &amp; m)<br/>&nbsp;&nbsp;&nbsp; n = n + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If n = 20 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells((m - 2) \ 20 + 2, 3) = str<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; n = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; str = ""<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else: GoTo 100:<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>100:<br/>Next m<br/>End Sub</p><p>做后才发现，只有4楼的答案最完整，我的和2楼一样，少了“<a href="mailto:“A261@sina.com">A261@sina.com</a>”以后的。如果把循环终值加20，最后又会多出9个“，”。另外，2楼的答案有一处错误“If (i +1) Mod 20 = 0 Then”应为“If (i - 1) Mod 20 = 0 Then”。</p><p></p>

[此贴子已经被作者于2007-12-16 21:03:04编辑过]

杨副官

Sub 分隔()<br/>Dim mrow1 As Integer, mrow2 As Integer, i As Integer, str As String, k<br/>mrow1 = Sheets("Sheet1").Range("a65536").End(xlUp).Row<br/>mrow2 = Sheets("Sheet1").Range("b65536").End(xlUp).Row + 1<br/>&nbsp;For i = 2 To mrow1<br/>&nbsp;&nbsp; k = k + 1<br/>&nbsp;&nbsp; If k &lt; 20 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp; str = str &amp; Cells(i, 1) &amp; ","<br/>&nbsp;&nbsp; ElseIf k = 20 Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; str = str &amp; Cells(i, 1) &amp; ","<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; str = Left(str, Len(str) - 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Sheets("Sheet1").Cells(mrow2, 3) = str<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; mrow2 = mrow2 + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; k = 0<br/><font color="#f70968">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; str = "" 　'开始还少这一句，致使出错。</font><br/>&nbsp;&nbsp; End If<br/>Next i<br/>End Sub<br/>

[此贴子已经被作者于2007-12-17 0:31:35编辑过]

zhangyilike

<p>作业来在晕</p><p>再来偷学点看能不能开开窍……</p>[em03]

alexpan

Sub test()<br/>Dim email As String, x%, y%<br/>&nbsp;&nbsp;&nbsp; n = 2<br/>For x = 2 To 300 Step 20<br/>&nbsp;&nbsp;&nbsp; email = ""<br/>&nbsp;&nbsp;&nbsp; For y = x To x + 19<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If email = "" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; email = Range("a" &amp; y).Value<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; email = email &amp; "," &amp; Range("a" &amp; y).Value<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(n, 3) = email<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Next y<br/>&nbsp;&nbsp;&nbsp; n = n + 1<br/>Next x<br/>End Sub

[此贴子已经被作者于2007-12-16 21:39:27编辑过]