循环合并 vba循环

iamexcel · 发表于 2012-12-2 17:30

详见附件。

从A列开始循环。每代人，只要有名字的，就将身世、通讯录、数据库复制到“目标”中的单元格上。A列循环结束就开始E列的。循环每代，每代相隔3行，有N代。“目标”工作表第A列需要写入第几代。{:soso_e100:}

各位大侠帮忙查看。谢谢！

840205910 · 发表于 2012-12-2 18:29

本帖最后由 840205910 于 2012-12-3 07:57 编辑

Sub 汇总1()
arr = Sheet1.UsedRange
ReDim brr(1 To UBound(arr), 1 To 6)
For j = 1 To UBound(arr, 2) - 3 Step 4
For i = 4 To UBound(arr)
If arr(i, j) <> "" Then
n = n + 1
brr(n, 1) = n
brr(n, 2) = arr(2, j)
brr(n, 3) = arr(i, j)
brr(n, 4) = arr(i, j + 1)
brr(n, 5) = arr(i, j + 2)
brr(n, 6) = arr(i, j + 3)
End If
Next
n = n + 3
Next
Sheet2.[a2].Resize(UBound(brr), 6) = brr
End Sub

840205910 · 发表于 2012-12-2 18:30

合并.zip (12.49 KB, 下载次数: 16)

840205910 · 发表于 2012-12-2 18:40

Sub 汇总1()
arr = Sheet1.UsedRange
ReDim brr(1 To UBound(arr), 1 To 6)
For j = 1 To UBound(arr, 2) - 3 Step 4
For i = 4 To UBound(arr)
If arr(i, j) <> "" Then
n = n + 1
brr(n, 1) = n
brr(n, 2) = arr(2, j)
brr(n, 3) = arr(i, j)
brr(n, 4) = arr(i, j + 1)
brr(n, 5) = arr(i, j + 2)
brr(n, 6) = arr(i, j + 3)
End If
Next
Next
Sheet2.[a2].Resize(UBound(brr), 6) = brr
For k = Sheet2.[b65536].End(3).Row To 3 Step -1
If Cells(k, 2) <> Cells(k - 1, 2) Then
Rows(k & ":" & k + 2).Select
Selection.Insert Shift:=xlDown
End If
Next
End Sub

iamexcel · 发表于 2012-12-2 19:24

本帖最后由 iamexcel 于 2012-12-2 19:25 编辑

840205910 发表于 2012-12-2 18:40
Sub 汇总1()
arr = Sheet1.UsedRange
ReDim brr(1 To UBound(arr), 1 To 6)

感谢大侠帮忙！代码好用。你真正读懂了需求啊哈哈谢谢。！
想知道ReDim brr(1 To UBound(arr), 1 To 6) 什么意思啊。请指导下。

时光鸟 · 发表于 2012-12-2 20:35

本帖最后由时光鸟于 2012-12-2 22:07 编辑

代码在附件里，点第二个工作表中的按扭生成，修改后附件见9楼

iamexcel · 发表于 2012-12-2 21:52

时光鸟发表于 2012-12-2 20:35
代码在附件里，点第二个工作表中的按扭生成

代码不可用。都是重复的了、

时光鸟 · 发表于 2012-12-2 21:58

iamexcel 发表于 2012-12-2 21:52
代码不可用。都是重复的了、

恩，没有测试，是有点问题，我改改

时光鸟 · 发表于 2012-12-2 22:07

iamexcel 发表于 2012-12-2 21:52
代码不可用。都是重复的了、

刚才有事出去，忙着写完了没测试就放上去了，不好意思，这次经修改后，测试正常

合并.rar (12.09 KB, 下载次数: 11)

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

循环合并 vba循环

评分