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

suye1010 · 发表于 2007-12-19 14:01

Sub CardToTable() Dim i As Long, No As Long, m&, n&, x& No = Sheets("卡片").Range("A:A").Find("姓名", , xlValues, xlWhole, , xlPrevious).Row \ 5 + 1 i = 0 t = Timer Do m = 5 * i + 1 n = 5 * i + 4 x = i + 2 Sheets("卡片").Range("B" & m & ":B" & n).Copy Cells(x, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True i = i + 1 Loop Until i = No MsgBox Timer - t End Sub

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

清荷枫儿 · 发表于 2007-12-19 22:14

Sub 卡片转移() Dim x%, k% With Sheets("卡片") k = 2For x = 1 To .Range("a65536").End(xlUp).Row Step 5 Cells(k, 1) = .Cells(x, 2) Cells(k, 2) = .Cells(x + 1, 2) Cells(k, 3) = .Cells(x + 2, 2) Cells(k, 4) = .Cells(x + 3, 2) k = k + 1 Next xEnd With End Sub名字E和I 上面多了一个名字A! 开始时没留意，调试一晚上一直显示不正确，后来一个一个运行，才发现是那里出了问题，真晕！做完后看贴子才发现高手真多，我是中规中距的一步一步的做。[em04]

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

guideming · 发表于 2007-12-20 11:49

Sub 转换()     Dim k&     With Sheets("卡片")         For k = 0 To .Range("A65536").End(xlUp).Row             Cells(k \ 5 + 2, (k Mod 5) + 1) = .Range("B" & k + 1).Value         Next k     End With End Sub未考虑多出姓名的

BeyondPC · 发表于 2007-12-21 12:56

Sub BeyondPC6_2() Dim i%, x%, y% With Sheets("卡片") x = 0 y = 2 For i = 1 To .Range("A65536").End(xlUp).Row     If i Mod 5 <> 0 Then     x = x + 1     Else     x = 1     i = i + 1     y = y + 1     End If     Sheets("数据表").Cells(y, x) = .Cells(i, 2) Next i End With End Sub

greenzhu · 发表于 2007-12-22 14:02

Sub 卡片() Dim x%, y% y = 2 With Sheets("卡片")   For x = 1 To .Range("b65536").End(xlUp).Row Step 5    Cells(y, 1) = .Cells(x, 2).Value    Cells(y, 2) = .Cells(x + 1, 2).Value    Cells(y, 3) = .Cells(x + 2, 2).Value    Cells(y, 4) = .Cells(x + 3, 2).Value    y = y + 1   Next End With End Sub

hncd · 发表于 2007-12-22 17:03

Sub ttt2()  With Sheets("数据表")  aab = Sheets("卡片").Range("a65536").End(xlUp).Row  For i = 1 To aab Step 5  For j = 1 To 4  aaa = .Range("a65536").End(xlUp).Row + 1  .Cells(aaa, j) = Sheets("卡片").Cells(j + i - 1, 2)  Next j  Next i  End With End Sub

hai · 发表于 2007-12-23 02:53

?/p>[em01]

jianzh · 发表于 2007-12-23 15:31

Sub TT1() Dim X, y, z As Integer For X = 1 To Sheets("卡片").Range("A65536").End(xlUp).Row \ 5 y = Sheets("数据表").Range("A65536").End(xlUp).Row + 1   For z = 1 To 4      Sheets("数据表").Cells(y, z) = Sheets("卡片").Cells((X - 1) * 5 + z, 2)   Next z Next X End Sub

雪舞霓裳 · 发表于 2007-12-29 11:38

<div class="msgheader">QUOTE:</div><div class="msgborder">以下是引用cfq-xxj在2007-12-18 22:43:00的发言： <div class="msgheader">QUOTE:</div><div class="msgborder">以下是引用mjm96511在2007-12-18 22:37:00的发言： Sub 数据转换() Dim a As Integer, b As Integer a = Sheets("卡片").Range("A65536").End(xlUp).Row For i = 1 To Int(a / 5)     For j = 1 To 4         b = 5 * (i - 1) + j         Sheets("数据表").Cells(i, j) = Sheets("卡片").Cells(b, 2)     Next Next End Sub</div>高手</div>为什么用这些代码我运行后结果不对??[em01]

cyswinner · 发表于 2008-2-4 15:56

Sub bb() Dim a As Long Dim b As Long b = 1 For a = 1 To 100 Step 5  With Sheets("数据表")  .Cells(b + 1, 1) = Sheets(1).Cells(a, 2)  .Cells(b + 1, 2) = Sheets(1).Cells(a + 1, 2)  .Cells(b + 1, 3) = Sheets(1).Cells(a + 2, 2)  .Cells(b + 1, 4) = Sheets(1).Cells(a + 3, 2)   b = b + 1 End With Next a End Sub老师表中有两个格是有两个名字的，是故意这样的，还是写错了。我是按每个人都是4格子写的。

		自动登录	找回密码
密码			注册

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

学习了do loop 试验了一下