【v1-6综合练习题2】卡片转数据表格式存放

兰色幻想

<p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 这是原来同事问我的一个问题，是把多个卡片格式的个人信息转换为数据表格式存放。当时用函数做的，这里要求大家用VBA来完成。详见下图。不必上传文件，直接把代码贴上来即可。</p> bdoYPA8K.rar (2.6 KB, 下载次数: 123)

2007-12-16 15:06 上传

点击文件名下载附件
【v1-6综合练习题2】卡片转数据表格式存放 <br/>

mxg825

Sub 转换()<br/>Dim i As Integer, a As Integer<br/>&nbsp;a = 2<br/>For i = 1 To Sheets(1).Range("b65536").End(xlUp).Row Step 5<br/>With Sheets(1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(a, 1) = .Cells(i, 2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(a, 2) = .Cells(i + 1, 2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(a, 3) = .Cells(i + 2, 2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Cells(a, 4) = .Cells(i + 3, 2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; a = a + 1<br/>&nbsp;&nbsp; End With<br/>&nbsp;Next<br/>End Sub<br/>

chenyf_ly

<p>卡片表第22、43行姓名重复</p><p>Sub hhh()<br/>&nbsp;&nbsp;&nbsp; j = 2<br/>&nbsp;&nbsp;&nbsp; Sheets("数据表").Select<br/>&nbsp;&nbsp;&nbsp; For i = 1 To Sheets("卡片").Range("a65536").End(xlUp).Row Step 5<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; With Sheets("数据表")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Cells(j, 1) = Sheets("卡片").Cells(i, 2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Cells(j, 2) = Sheets("卡片").Cells(i + 1, 2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Cells(j, 3) = Sheets("卡片").Cells(i + 2, 2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Cells(j, 4) = Sheets("卡片").Cells(i + 3, 2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End With<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; j = j + 1<br/>&nbsp;&nbsp;&nbsp; Next<br/>End Sub</p>

mxg825

<p>兰版！名字E和I 上面多了！一个名字A!</p><p>是不是加上去的难度？</p>

mxg825

3楼和我异曲同工！哈哈。。。。[em01]

兰色幻想

<div class="msgheader">QUOTE:</div><div class="msgborder"><b>以下是引用<i>mxg825</i>在2007-12-16 15:40:00的发言：</b><br/><p>兰版！名字E和I 上面多了！一个名字A!</p><p>是不是加上去的难度？</p></div><p></p>随意编写个人信息,只要把格式转换过来就行了

hong4777

<p>Sub ts()<br/>&nbsp;' 删除了两行重复的姓名</p><p>&nbsp;With Sheets("卡片")<br/>&nbsp;&nbsp; Dim t&amp;<br/>&nbsp;&nbsp;&nbsp; n = 1<br/>&nbsp;&nbsp;&nbsp; t = .Range("a65536").End(xlUp).Row<br/>&nbsp; For a = 1 To t<br/>&nbsp;&nbsp;&nbsp;&nbsp; If (a - 1) / 5 = n Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; n = n + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Sheets("数据表").Cells(n + 1, (a - 1) Mod 5 + 1) = .Cells(a, 2).Value<br/>&nbsp; Next<br/>&nbsp;End With<br/>End Sub</p><p></p>

hhzjxss

<p>刚看到，又要下班了！</p>

minant

先占个位！<br/><br/>我的好了！[em01][em01][em01]<br/>Sub exercise2()<br/>Dim y As Long<br/>&nbsp;&nbsp;&nbsp; With Sheets("卡片")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For y = 1 To .Cells(65536, 1).End(xlUp).Row<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Sheets("数据表").Cells(Sheets("数据表").Cells(65536, 4).End(xlUp).Row + 1, _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ((y - 1) Mod 5 + 1)).Value = .Cells(y, 2).Value<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp; End With<br/>End Sub<br/><br/><br/>

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

alexpan

Sub 卡片转数据表()<br/>Dim x%, y%, n%, i%<br/>With Sheet2<br/>&nbsp;&nbsp;&nbsp; x = Sheet1.Range("a65536").End(xlUp).Row<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i = 1 To 4<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For n = i To x + i - 4 Step 5<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; y = Sheet2.Cells(65536, i).End(xlUp).Row + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; .Cells(y, i) = Sheets(1).Cells(n, 2).Value<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next n<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next i<br/>'MsgBox Sheet1.Cells(n, 2).Address&nbsp; '为什么最后一个单元格会显示"B89"? 不是到84为止就停了吗?<br/>End With<br/>End Sub