循环合并 vba循环

iamexcel

详见附件。

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

840205910

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

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

2012-12-2 18:30 上传

点击文件名下载附件

840205910

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

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) 什么意思啊。请指导下。

时光鸟

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

iamexcel

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

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

时光鸟

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

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

时光鸟

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

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

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

2012-12-2 22:06 上传

点击文件名下载附件